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Large  amounts  of  data  collected  during  experiments  or 
produced  as  outputs  of  programs  that  simulate  systems, 
usually  need  further  treatment  in  order  to  complete  the 
research  task.   One  step  of  the  data  analysis  process  is 
the  manipulation  of  the  data. 

The  data,  even  when  stored  in  a  computer,  can  be  con- 
sidered as  inert  if  it  cannot  be  manipulated.   Manipulation 
may  be  considered  any  appropriate  arrangement  or  transfor- 
mation of  a  logical  data  matrix  composed  by  the  data. 

The  inert  data  matrix  is  activated  and  becomes  an 
"Active  Matrix"  by  the  developed  system  IDAMAN  (Interactive 
DAta  MANager) .   It  is  expected  that  this  system,  based  on  the 
idea  of  Dr.  Daniel  Guinier,  fulfills  the  demands  for  such 
manipulations.   Compared  to  existing  similar  alternative 
systems,  this  system  possesses  two  particular  merits:   No 
specific  language  is  required;  and  the  separation  of  data 
manipulation  task  from  acquisition  and  future  calculus  grants 
to  the  system  a  high  power  of  expandability. 
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I .   GENERAL  DESCRIPTION  OF  I DAMAN 

A.   INTRODUCTION 

Research  in  many  scientific  fields  is  usually  involved 
with  such  a  large  amount  of  data  that  manipulation  becomes 
difficult,  time  consuming  and  error  prone.   A  large  amount 
of  data  requires  auxilliary  storage  such  as  a  disk  for  backup 
and  data  processing,  while  the  efficiency  required  calls 
for  direct  access  organization  of  the  data  file.   The  accom- 
plishment of  such  a  task  requires  several  considerations. 

The  first  consideration  is  availability  of  the  data. 
The  sources  of  data  are  either  application  programs  in  several 
areas  such  as  language  analysis,  biology  [Refs.  1  and  2], 
simulation,  etc.,  or  observations  and  measurements  during 
experiments.   The  data  are  either  readily  available  for 
manipulation  or  must  be  inserted  into  the  system  by  the  user 
via  the  keyboard. 

The  second  consideration  is  the  nature  of  manipulation 
of  the  data  that  has  to  be  performed  after  it  is  available  in 
the  machine.   The  provided-by-the-system  manipulation  ability 
has  to  be  such  that  the  manipulated  data  will  be  ready  for 
the  next  of  the  process,  namely  the  mathematical  model  analysis, 
graphics,  or  statistical  calculus.   The  system  must  also  be 
capable  of  covering  as  many  cases  as  possible.   The  data  must 
be  stored  in  an  organized  virtual  structure,  e.g.,  easily 
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realized  by  the  user  logical  table  or  matrix  on  random  mass 
storage . 

The  above  considerations  call  for  a  computer  methodology 
that  gives  to  the  system  DATA-USER-DATA  manager  a  high  level 
of  interactivity,  and  at  the  end  of  the  fourth  step  (Fig.  1) , 
maximum  services  with  minimum  user  activity.   The  data  must 
be  organized  by  the  user  so  that  it  can  be  easily  referred 
to,  and  manipulated.   The  creation  of  such  an  organization 
of  the  data  can  be  called  a  "header"  of  the  data  matrix. 

B.   CONCEPT  OF  THE  INTERACTIVE  DATA  iMANAGER,  I  DAMAN 

To  perform  a  complete  data  processing  cycle,  the  Inter- 
active Data  Manager,  IDAMAN,  supports  two  kinds  of  functions: 
Creation  of  a  header. 

Data  manipulation  according  to  the  user  defined  header. 
The  user  is  not  involved  with  the  manipulation  of  the 
data  but  rather  only  assigns  what  manipulation  is  desired, 
by  creating  the  header  of  the  data  matrix.   At  the  same  time, 
the  system  supervises  the  creation  of  the  appropriate  files 
that  are  transparent  to  the  user. 
1 .   Creation  of  the  Header 

An  interactive-informative  communication  between 
computer  and  user  creates  the  header.   The  created  header 
contains  information  regarding  the  columns  and  the  rows  of 
the  data  matrix.   Such  information  causes  the  manipulation 
of  the  data.   The  header's  data  are  integers  (e.g.,  number 
of  columns,  number  of  rows) ,  reals  (e.g.,  actual  or  imposed 
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by  the  user  boundary  values  (extrema)  for  each  column)  and 
characters  (e.g.,  names  of  the  variables,  names  of  sets  of 
observations  (rows)) . 

Several  data  of  the  header  are  stored  in  the  mass 
storage  in  a  sequential  access  file  for  future  use. 
2 .   Manipulation  of  the  Data 

The  data  to  be  manipulated  are  stored  in  mass  storage 
in  direct  access  organization  files  and  in  the  logical  form 
of  a  matrix  with  dimension  NCOL*NROW,  where  NROW  is  the 
number  of  rows  (or  observations  or  lines)  and  NCOL  is  the 
number  of  columns  (or  parameters) . 

The  manipulation,  a  transparent  operation  of  the  sys- 
tem, is  executed  during  the  creation  of  the  header  and  at 
the  same  time  that  each  manipulation  is  assigned.   The  manipu- 
lation of  the  data  causes  the  creation  of  a  new  direct  access 
file  in  the  secondary  storage  whenever  it  is  considered 
necessary.   The  same  file  is  used  in  the  opposite  case  for 
space  economy  reasons . 

Manipulation  functions  executed  by  the  I DAMAN  are: 
Addition  or  suppression  of  lines  or  columns. 
Rearrangement  of  the  order  of  lines  or  columns  (ranking) 
Transformation,  single  or  multipass,  is  performed  by 
analysis  of  a  full  input  character  string  (representing 
the  transformation)  conversion  from  infix  to  postfix 
notation,  and  evaluation  using  push-down  stack.   The 
assigned  transformations  may  include  functions  with 
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arguments  such  as  the  number  of  columns  (actually  the 
value  corresponding  to  column  will  be  used  as  an  argument) , 
reals  or  integers,  and  the  number  of  columns  (in  that 
case  the  value  corresponding  to  the  column  number  is 
taken  to  be  constant) . 

Sorting  column  guides,  single  or  multiple,  where  suc- 
cessive sortings  are  executed  as  a  function  of  successive 
columns . 

Searching  for  a  particular  value  or  a  missing  value 
involving  the  entire  data  matrix  or  columns  and/or  rows 
assigned  by  the  user. 

Randomization  of  row  order  to  eliminate  problems  created 
due  to  collection  time  effect. 

Merging  of  two  f iles--either  row-row  (one  over  the 
other) ,  or  column-column  (one  beside  the  other) . 
Display  of  the  data  matrix  with  user  defined  format  via 
the  keyboard. 

As  soon  as  the  inert  data  are  involved  in  a  manipulation 
process,  IDAMAN  can  be  considered  as  activated.   The  data 
matrix  with  its  assigned  header  can  be  called  an  "ACTIVE 
DATA  MATRIX. " 

Fig.  2  illustrates  the  comparison  of  three  different 
concepts:   a)   an  interactive  and  conversational  system  for 
data  analysis  applied  to  biology  [Refs .  1  and  2];  (b)  the 
IDA  from  SPSS  (Interactive  Data  Analysis  from  the  Software, 
Package  for  Social  Sciences);  and  (c)  the  presented  system, 
I  DAMAN . 

14 


1/1  — 

< 


1)  = 

—  -3 

a  - 

—  5 

< 


< 


\       ^ 


-    I 


I      7! 

!   =  i 


0 

> 

•H 

+J 

u 

ITS 

M 

dj 

+j 

c 

H 

4-1 

0 

en 

-p 

a 

CD 

0 

c 

0 

u 

.— 1 

en 

03 

- 

S-i 

CD 

<D 

-1-1 

> 

en 

<D 

> 

CO 

00 

m 

CO 

0 

•H 

W 

j" 

>i 

0 

i— 1 

co 

- 

•H 

£ 

M 

< 

(3 

Qj 

03 

E 

+J 

0 

<T3 

U 

Q 

CM 


/ 


u  — 


^  — 
>  — 


fl 

S 

31 

En 

0 

- 

a 

4» 

> 

o 

3 

a 

— 

St 

•o 

CI 

u 

■3 

•a 

3 

z 

0 

U 

w 

C 

- 

- 

CI 

1 

■D 

'O 

— 

0 

5 

■o 

*- 

J. 

u 

3 

— 

0 

■3 

3    .H    0) 


D   m   tj 

a;  —    3 

"3   — 


•0  T> 

c-)           —  — 

■0  3 

3  C. 


15 


C.  CONCEPTUAL  PROPERTIES  OF  THE  DEVELOPED  SYSTEM  I DAMAN 

The  developed  system  I DAMAN  has  the  following  properties: 
Universality  of  the  source  language:   structured  FORTRAN 
77  is  used  for  the  implementation  of  the  system. 
Portability:   Granted  by  the  use  of  FORTRAN  77  and  the 
organization  of  the  program.   The  required  central  memory 
size  can  even  be  satisfied  by  a  microcomputer  with  module 
overlay . 

Simplicity  of  use:   No  special  knowledge  or  language  is 
required  for  the  use  of  the  system. 

All  operations  like  creation  and/or  saving  the  data 
on  files,  are  transparent  to  the  user.   Display  or 
printing  the  data  contained  on  these  files  (header  or 
data  file)  is  very  simple  and  does  not  need  any  special 
consideration  about  formats. 

D.  EXISTING  SIMILAR  SOFTWARE  PACKAGES  FOR  DATA  ANALYSIS 
Existing  known  packages  providing  the  same  task  can  be 

divided  into  two  categories: 

Packages  of  subroutines  for  specific  calculations  with- 
out system  data  manipulation;  such  systems  are  the 
HARWELL  Library  (19  81)  from  the  United  Kingdom  Energy 
Authority,  the  IMSL  Library  (1982) ,  and  the  System  360 
Subroutines  Library  (1968) . 

Packages  of  subroutines  for  calculations  with  the 
system  of  data  manipulation;  such  systems  are  the  Bio- 
MeDical  Package  (BMDP,  1981),  and  the  Statistical 
Package  for  the  Social  Sciences  (SPSS,  1983). 
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BMDP  and  SPSS  are  complete  statistical  packages.   The 
first  one  is  produced  by  UCLA  (University  of  California  at 
Los  Angeles)  and  is  oriented  toward  Bio-medical  statistical 
applications.   The  second  is  oriented  to  social  science 
statistical  applications.   These  two  packages  have  a  wide 
range  of  applications  in  statistics  but  are  not  interactive 
and  use  their  own  conventional  languages. 

In  the  SPSS  series  in  data  analysis,  IDA  is  presented  as 
an  interactive  data  analysis  and  forecasting  system  (1982) . 

The  difference  between  the  concepts  of  IDA  and  I DAMAN  is 
that  in  IDA,  the  data  are  manipulated  and  elaborated  by  the 
same  program  (data  summarization,  regression,  time-series 
analysis,  etc.) ,  while  in  IDAMAN,  only  manipulation  is  exe- 
cuted.  IDAMAN  is  strictly  a  data  manipulation  system.   The 
intention  of  the  design  was  to  separate  the  two  tasks  —  con- 
sidering them  as  different.   In  this  way,  modularization  is 
obtained.   The  next  step  of  the  general  task  "data  analysis" 
can  be  executed  separately  by  another  module.   The  data,  after 
the  manipulation,  are  used  by  independent  or  interdependent 
modules.   Such  modules  can  provide  one,  two  or  mult i variable 
analysis  (mathematical  and/or  statistical)  involving  one  or 
several  samples  or/and  series  of  samples.   The  IDAMAN  pro- 
vides the  flexibility  of  executing  the  same  data  elaborations 
with  the  same  data  in  different  forms  (manipulations) . 

The  calculation  subroutines,  described  by  several  similar 
packages,  can  be  integrated  by  the  process  of  a  calling  program 
that  reads  the  data  of  the  header  created  by  the  IDAMAN. 
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E  .   MATERIAL 

IDAMAN  was  developed  at  the  Department  of  Computer  Science 
at  the  Naval  Postgraduate  School,  Monterey,  California  on  the 
VAXll/7  80  under  the  VMS  operating  system.   The  disposable 
virtual  memory  is  32  Megabytes  and  the  direct-access  memory 
is  the  user's  disk  RMO 5  (256  Megabytes) . 

FORTRAN  77  on  VAXll  permits  the  use  of  the  facilities 
given  to  a  32  bit  or  to  a  16  bit  computer  (PDPll  or  LSI1I  or 
any  other  16  bit  microcomputer  precision  for  integer  and  real 
numbers,  e.g.,  integers  on  2  bytes  or  on  4  bytes) . 

The  modularity  of  the  program  implementing  the  IDAMAN 
permits  a  transportability  to  a  lower  memory  capacity  micro- 
computer (16  bit  or  16  bit-like  microcomputer) . 

F.   OVERVIEW  OF  FUNCTIONAL  CAPABILITIES  OF  IDAMAN 

Column  mnemonics:   used  to  assign  mnemonic  names  to 
columns  (parameters  or  variables) . 
Row  mnemonics:   used  to  assign  mnemonic  names  to 
individual  rows  and/or  sets  (or  subsets)  or  rows.   In 
this  way  the  data  can  be  retrieved  by  index  (the  set 
number)  or  by  the  row  or  set  mnemonic  name.   An  example 
of  the  usefulness  of  this  operation  is  the  comparison 
of  means  of  sets  or  the  tracing  of  groups  of  data. 
Tracing  extrema:   used  to  permit  the  user  to  change 
the  extrema  values  by  giving  a  "window"  for  tracing. 
With  thj.s  function,  the  system  does  not  need  additional 
information  about  scales  if  a  tracing  application  program 
is  required. 


Sorting  and  multi-sorting:   used  to  reorganize  the  data 
according  to  column  guides  by  sorting  successively  in 
increasing  order  to  generate  sets  and  subsets  of  rows 
(observations) . 

Data  retrieval:   used  to  find  one  or  several  values 
inside  specific  fields  (column(s)  or  row(s))  or  a 
specific  "gold"  number  that  corresponds  to  missing  values 
The  process  of  retrieval  is  applied  in  the  full  matrix 
or  in  particular  parts  of  it,  given  by  the  user.   The 
data  to  be  retrieved  can  be : 

Identified  as  erroneous  data. 

Missing  data  which  are  referenced  as  a  "gold" 
value  internal  to  the  system  or  changed  by  the  user 
to  represent  a  pseudo-improbable  value. 
Listed,  and  the  associated  row,  column  and  index 
numbers  are  given  to  the  user.   This  information 
will  be  useful  for  eventual  corrections  or  localiza- 
tion on  the  listing. 
Rearrangement:   used  to  eliminate  the  column  guides  used 
for  multisorting  or  to  partition  the  data  matrix  for 
particular  elaborations  (e.g.,  multiple  partial 
regression) . 

Transformations:   used  to  restore  some  statistical 
properties  or  to  perform  directly  mathematical  operations 
involving  data  of  the  matrix  and/or  numbers. 
Randomization:   used  to  burst  the  original  data  to 
avoid  effects  of  time  or  preordering. 
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Compression:   used  to  suppress  some  data  for  future 
calculations  (logical  suppression)  without  physical 
suppression  of  the  data.   This  operation  can  be  done 
using  a  special  compressed  binary  file  [Refs.  3  and  4]  . 
Input/Output:   transparent  to  the  user  and  can  be 
directed  to  the  desired  device  or  file. 
Files  generation:   operations  also  transparent  and 
executed  by  assignment  of  a  single  key  (number  of 
alphanumeric) . 

Display  of  the  header's  information:   used  to  facilitate 
the  use  of  the  program  and  the  creation  of  the  header. 
Display  the  data:   used  to  display,  on  the  terminal,  the 
manipulated  data  being  on  direct  access  files  in  secondary 
memory,  by  a  simple  command  and  in  format  defined  by 
the  user,  if  any  change  of  the  normal  format  is  required 
(e.g.,  nnnnnn.nn  gives  FORTRAN  format  F9.2). 
Merging:   Files  can  be  merged  in  a  row-row  (one  over 
the  other)  or  column-column  (one  aside  the  other)  sense 
without  any  particular  user  involvement. 

G.   DESIGN 

1 .  Modular  Structure  of  IDAMAN 

Figs.  3  and  4  present  the  structure  of  IDAMAN,  showing 
all  the  subroutines  used  and  the  overlay  form.   The  source 
code  of  the  system  is  presented  in  Appendix  A. 

2 .  Brief  Description  of  the  Subroutines 

ANADIS:   Analyzes  strings  used  to  assign  numbers  of  columns 
or  rows  that  have  to  be  displayed,  retrieved  or 
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rearranged  (e.g.,  1,4,6:9,3  assigns  successive 
numbers  14  6  7  8  9  3) 

ASBYMN:   Permits  the  assignment  of  columns  or  rows  by  their 
mnemonic  names. 

CDISP:    Displays  on  the  screen  information  about  the  columns 
of  the  header. 

COLINF:   Presents  the  selection  table  of  the  column  informa- 
tion, and  calls  the  appropriate  subroutine  regarding 
the  information  to  be  assigned  by  the  user. 

COLMOD:   Modifies  the  information  about  the  columns. 

COLNAM:   Assigns  mnemonic  names  to  columns. 

COMCOL:   Merges  (combines)  two  data  files  and  their  headers 
in  the  column-column  (one  over  the  other)  sense. 

COMP :     Computes  the  values  of  functions  used  in  the  user 
assigned  expressions  for  transformations. 

COMP01:   Gets  or  sets  the  binary  value  0  or  1  in  a  compressed 
binary  matrix  NROW*NCOL  for  any  I's  and  J's. 

COMROW:   Merges  (combines)  two  data  files  and  their  headers 
in  the  row-row  (one  over  the  other)  sense. 

CONV:     Converts  (analyzes)  the  expression  string  assigned 
for  the  transformation  in  an  infix  notation  expres- 
sion.  This  string  is  composed  from  character  defined 
numbers,  letters,  delimiters,  etc.   It  is  decomposed 
to  the  several  elements  that  constitute  the  infix 
expression.   It  calls  the  subroutines  POSTF  and  EVAL 
for  further  processing  of  the  expression.   It  stores 
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the  result  of  the  evaluation  on  the  next  rightmost 
end  of  the  data  matrix  —  creating  a  new  column. 

CRANK:    Assigns  column  ranking  by  column  number  or  column 
mnemonic  names.   The  assignment  of  the  columns  can 
be  done  as  in  the  previous  paragraph  and  the  same 
subroutines  are  used.   After  the  assignment,  it  call 
the  corresponding  subroutine  (RANK1  or  RANK2)  for 
ranking  of  columns. 

CREATE:   Creates  a  new  header.   It  opens  the  sequential  file 
on  which  information  of  the  created  header  will  be 
stored  and  passes  control  of  the  program  to  the 
subroutine  CRINFO.   At  the  end  of  the  creation,  it 
calls  WRITER  for  recording  of  information,  which 
resides  in  the  main  memory,  to  the  opened  file  in 
mass  storage. 

CRINFO:   Determines  if  either  column  or  row  information  is 
to  be  assigned  next.   It  calls  the  appropriate 
subroutine  COLINF  or  ROWINF . 

DISDAT:   Displays  any  or  all  user  assigned  (columns,  rows) 
parts  of  the  data  file. 

DISPLA:   Displays  on  the  CRT  the  information  related  to  the 

columns  and  rows  of  a  previously  defined  header.   It 
opens  the  sequential  file  on  which  information  is 
stored,  calls  READER  which  reads  the  information  and 
stores  it  in  the  main  memory  and  then  calls  CDISP 
and  RDISP  which  display  information  about  columns 
and  rows . 
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EXTREM:   Assigns  tracing  extrema . 

EXSH1 :    Executes  internal  and  address  calculation  sorts 

using  Shell's  method  to  rank  elements  in  increasing 
order,  modified  for  address  calculations. 

FICH:     Opens  at  run  time,  direct  access  unformatted  or 
sequential  files  named  'FORnnn.DAT'. 

FINDMM:   Evaluates  the  minimum  and  maximum  value  of  each 
column  of  the  data  matrix. 

FORM:     Permits  the  user  to  determine  the  format  of  the  data 
that  will  be  displayed. 

ENSORT:   Permits  Input/Output  modifications  or  assignments 
for  physical  Input  and/or  Output,  and/or  Print  for 
Devices  or  Files  within  a  FORTRAN  Program  or 
Subroutine . 

EVAL :     Evaluates  (computes  the  result)  the  postfix  expression 

MERGE:    Merges  two  existing  headers.   It  opens  the  two 

files  to  be  merged  and  calls  COMCOL  or  COMROW  for 
the  merging  of  the  two  files  in  the  column- column 
(one  aside  the  other)  sense  or  row-row  (one  over 
the  other)  sense. 

MODIFY:   Modifies  an  existing  header.   It  opens  the  file  on 
which  information  is  stored,  calls  READER  to  pass 
it  from  the  secondary  to  the  main  memory  and  calls 
the  appropriate  subroutine  for  the  modification 
(COLMOD  for  column  or  ROWMOD  for  row)  which  actually 
executes  the  modification.   At  the  end,  it  restores 
the  modified  information  by  calling  WRITER. 
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MULSOR:   Assigns  the  guides  (column  numbers  or  column  mnemonic 
names)  that  will  be  used  for  the  multiple  sorting. 
It  calls  the  subroutine  ANADIS  which  analyzes  the 
string  of  column  numbers  and  characters  ( " , "  and/or 
":")  assigned  by  the  user  via  the  terminal  and  iso- 
lates the  column  numbers  when  the  assignment  is 
done  by  column  numbers.   If  the  assignment  is  done 
by  mnemonic  names,  it  calls  the  subroutine  ASBYMN 
which  stores  the  names  in  the  appropriate  array. 
In  both  cases  it  calls  the  appropriate  subroutine 
(REARl  or  REAR2)  for  further  processing. 

PFIX:     Converts  the  infix  expression  to  the  corresponding 
postfix  notation. 

RANDOM:   Randomizes  the  data  matrix. 

RANK:     Rearranges  the  columns  of  the  data  matrix  according 
to  the  column  numbers  assigned  by  the  user . 

RANK1 :    Rearranges  the  columns  of  the  data  matrix  according 
to  the  column  numbers  assigned  by  the  user. 

RANK 2 :    Rearranges  the  columns  of  the  data  matrix  according 
to  the  column  mnemonic  names.   It  calls  TRANS  to 
transform  the  column  name  to  the  column  number. 

RDISP:    Displays  on  the  screen  information  about  the  rows 
of  the  header. 

READER:   Records  information  regarding  the  header  on  a 
sequential  file. 

REAR:     Multisorts  the  data  matrix.   It  opens  the  direct- 
access  file  of  data,  and  consequently  calls  the 
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subroutine  EXTREE  for  the  sorting.   It  rearranges  the 
data  according  to  the  final  inverted  relative 
addresses  without  using  extra  file  for  temporary 
storage  of  the  data. 

REAR! :    Used  to  continue  the  process  of  multi-sorting 
column  numbers  by  calling  the  subroutine  REAR. 

REAR2 :    It  functions  like  REARl  for  column  assignment. 

It  calls  TRANS  to  transform  column  names  to  column 
numbers . 

REJECT:   Rejects  rows  not  involved  in  particular  computations 

("logical  suppression");  these  rows  are  not  physically 
suppressed  but  are  just  ignored  when  the  calculation 
is  executed.   The  row  to  be  rejected  is  given  the 
binary  value  of  zero  while  the  retained  row  is  given 
the  binary  value  of  one.   In  this  way,  bit  words  are 
converted  to  decimal.   The  purpose  of  the  method  is 
to  save  space  and  time. 

REORD:   .  Reorders  internally  (without  use  of  a  temporary  file) 
the  rows  of  the  data  file  after  multi-sorting  (via 
the  produced  invert  relative  addresses) . 

ROWINF:   This  corresponds  to  the  previous  subroutine  for 
rows  . 

ROWMOD:   Modifies  information  about  the  rows  of  the  header. 

ROWNAM:   Assigns  row  mnemonics. 

ROWSUP:   Presents  the  prompts  for  the  row  suppression 

assignment,  permits  the  assignment  of  the  suppression 
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row  numbers  which  are  stored  in  an  array,  and  calls 
the  subroutine  SUP  that  executes  the  suppression. 

SUP:      It  suppresses  the  rows  of  data  file  assigned  by  the 
previous  subroutine . 

SUPSET:   Suppresses  the  rows  of  the  data  matrix  that  corres- 
pond to  an  assigned  set  of  rows  with  a  common 
mnemonic  name. 

SEEDAT:   Retrieves  user  defined  data  or  searches  for  missing 
values  from  the  data  matrix. 

TESTER:   Tests  if  a  mnemonic  name  has  been  assigned  as  a 
column  mnemonic  name. 

TRANS:    Transforms  a  column  mnemonic  name  to  a  column 
number . 

TRSFRM:  Presents  the  table  of  the  available  functions  that 
can  be  used  for  transformations  and  calls  the  sub- 
routine CONV  that  calculates  the  assigned  expression 

WRITER:   Writes  the  information  regarding  the  header  on  a 
sequential  file. 
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II .   METHODS  USED  FOR  THE  IMPLEMENTATION 

A.   SORTING 

1 .   Introduction 

A  large  amount  of  data  may  need  to  be  sorted.   In 
order  to  avoid  intermediate  manipulations  in  mass  memory,  a 
study  of  the  most  efficient  method,  in  terms  of  timing,  has 
been  carried  out. 

If  the  data  matrix  is  stored  on  a  direct-access  file 
on  a  disk  and  not  in  central  memory  (which  is  the  general 
case) ,  a  sort  by  address  calculation  avoids  intermediate 
exchanges  between  central  and  secondary  memory.   This  results 
in  time  burdening  of  the  method  [Ref .  5]  . 

When  data  are  preordered,  methods  using  binary  trees 
must  be  avoided  because  they  tend  to  "bubble"  [Refs.  6  and  7]. 

When  multi-sorting  is  needed,  methods  requiring 
departure  boundaries  as  the  integer  result  of  a  division  by 
two  (dihotomic  methods) ,  are  inappropr iate--giving  wrong 
results  [Ref .  8] . 

Guinier  (1980  [Ref.  5]  has  shown  that  the  manipulation 
of  numbers  corresponding  to  records  stored  in  a  random  access 
RK05  disk  file  under  the  RTll  operating  system  considerably 
increases  the  elapsed  time  by  a  factor  of  40  if  MacLarren ' s 
method  is  used  and  more  than  80  if  Singleton's  method  is 
used.   It  is  necessary  to  transfer  the  records  of  the  file 
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in  an  image  array  of  the  column  to  sort  and  to  have  the 
ordered  elements  in  the  form  of  addresses  in  order  to  avoid 
manipulations  of  the  full  records  during  the  sort. 

2 .   Binary  Tree  Sorts  (Monkey  Puzzle,  Hoare  '  s  Quicksort) 
In  the  binary  tree  sorts,  elements  to  be  sorted  and 
contained,  in  a  corresponding  array,  are  scanned  and  placed 
at  the  appropriate  node  of  the  created  binary  tree.   The 
relative  position  of  the  node  on  which  an  element  will  be 
placed  in  the  tree  is  dependent  on  a  comparison  of  the  size 
of  each  element  with  the  elements  already  existing  on  the 
tree.   The  left  or  right  branch  is  selected,  respectively,  if 
the  element  is  larger  or  smaller. 

If  the  original  data  are  randomized: 
The  number  of  nodes  n  at  a  given  level  1  is  n  =  2**1. 
The  depth  of  the  resulting  binary  tree  is  d  =  log  2(n+l)  -  1 
The  number  of  comparisons  to  place  the  node  at  level  1 
is  1  + 1  and  the  total  number  of  comparisons  is  c  with 
d  +  cl  <=  c  <=  cl  and  cl  =  SUM  1  =  1  to  d-1  { (1  +1)  *2**1 }  . 
It  can  be  shown  that  c  is  approximately  equal  to 
n*log  2 (n) . 

If  the  original  data  are  preordered: 
The  resulting  tree  appears  like  a  single  branch  tree 
and  the  total  number  of  comparisons  is  c  =  2+3+4  +  ...  +n. 
That  is,  c  =  n*(n+l)/2  -  1  which  is  approximately  n*n/2 . 
The  .method  tends  to  "bubble",  with  the  number  of  compari- 
sons c  =  (n-l)**2  =  n**2  -  2 *n  + l--approximately  equal  to 
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n*n.   An  extra  array  is  needed  but  the  elements  are  not 
manipulated.   Hibbard  (1963)   [Ref.  9]  suggests  the  use 
of  Shell's  method  (Shell  (1959))  as  an  alternative  method 
not  sensitive  to  the  preordering.   In  the  case  of  dealing 
with  preordered  data,  a  good  strategy  is  to  randomize 
them  with  a  single  pass  before  sorting  and  without 
manipulation  of  the  file  records,  using  instead  randomi- 
zation of  the  addresses  by  which  the  data  will  be  read. 
This  is  done  by  the  randomization  function  of  the  I DAMAN. 

3 .  Shell ' s  Method 

This  method  uses  the  principle  of  interchange  by 
adjacent  pairs.   In  contrast  with  the  bubble  sort,  it  moves 
list  entries  at  most  one  position  at  a  time,  dividing  the 
original  list  of  n  entries  into  two  parts.   This  method  can 
compare  entries  that  are  two  positions  apart. 

This  method  is  insensitive  to  preordering.   But  an 
ambiguity  remains  in  the  calculation  of  m  =  integer  [m/2] 
and  cannot  be  used  for  multi-sorting. 

4 .  Singleton's  Method 

Singleton's  method  is  an  extension  of  Hoare's  "Quick- 
sort".  Because  a  tree  method  gives  bad  results  when  the 
items  are  presorted  or  take  a  constant  value,  the  problem 
has  been  changed  to  an  exchange  of  elements  when  they  are 
equal  to  or  greater  than  a  temporary  value  T  in  one  set  of 
values  and  less  than  T  in  the  other  set.   This  operation  gives 
a  better  split  of  the  original  set  of  items. 
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The  median  set  is  generally  missing.   Therefore, 
comparison  with  the  temporary  value  and  the  median  of  the 
values  of  X(i)  is  avoided.   X([i+j]/2)  and  X(j)  are  used  for 
T.   This  gives  a  better  estimation  of  the  median  element 
than  a  single  value. 

In  searching  for  two  elements  to  exchange,  the  data- 
almost-sorted  X(i)  and  X(j)  are  used  as  boundary  values. 
X(i)  <=  T  <=  X(j)  and  the  indexes  are  compared  after  perform- 
ing the  exchange. 

The  lower  and  the  upper  sets  must  have  approximately 
the  same  size  to  result  in  efficient  performance. 

Speed  of  the  method  is  greatest  for  less  than  11 
items  when  completing  the  sort  by  short  sequences  using 
Shell's  method  of  sorting  by  interchange  of  adjacent  pairs 
[Refs.  8  and  9] . 

For  N  elements,  the  dimension  of  the  lower  and  upper 

sets  (IL()  and  IUO)  must  be  k  with  N  =  2**(k-l)  -  1. 

5 .   Evaluation  of  Selected  Sort  Methods  in  Terms  of 
Performance 

Comparisons  between  the  "monkey  puzzle"  binary  tree, 

Shell's  and  Singleton's  sorting  methods  can  be  obtained  from 

the  following  data  which  represent  a  mean  of  ten  tests,  in 

order  to  reduce  the  effect  of  the  activity  of  the  VAX11 . 
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VAX1 

n 

Shell 

1,000 

0.4  s 

2,000 

1.1  s 

3,000 

2.1s 

5,000 

3.8  s 

10,000 

7.2  s 

For  randomized  data:   including  address  calculation,  on 


Tree  Singleton 
0.2s  0.2s 

0.6s  0.4s 

1.0s  0.6s 

2.0s  0.9s 

4.2s  1.9s 


For  preordered  data:   including  address  calculation,  on 

VAX11-VMS . 

n  Shell  Tree          Singleton 

1,000  0.2s  15.1s               0.1s 

2,000  0.5s  44.8s               0.2s 

3,000  1.1s  117.8s   (  1.9  ran)    0.3s 

5,000  1.9  s  310.1  s   (  5.1  mn)    0.5  s 

10,000  4.8  s  1,072.7  s   (17.9  mn)    1.0  s 

When  data  are  randomized  between  Tree's  and  Shell's 
methods,  Berztiss  (1975)   [Ref.  10]  gives  a  ratio  of  1.3  in 
favor  of  Tree's  on  an  Algol  version  running  on  a  CDC  1604A. 
The  ratio  of  the  presented  results  is  greater  than  this  value 
if  the  data  are  randomized.   Between  Tree's  and  Singleton's 
methods,  the  ratio  is  2  and  the  velocity  is  5  times  better 
on  theVAXll/780  than  the  results  given  by  Singleton  on  the 
Burroughs  B5500 . 

When  data  are  preordered,  degeneration  of  Tree's 
method  on  a  bubble  appears  clearly.   The  results  of  Shell's 
and  Singleton's  methods  are  stable  and  twice  as  good. 
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Singleton's  method  is  20  times  faster  on  the  VAX11/780 
under  VMS  than  on  a  PDPll/05  under  RT11 .   Guinier  (19  80) 
gives  4  s.  for  1000  items  [Ref.  10]. 

The  methods  selected  by  I DAMAN  are  Shell's  method  for 
original  single  sorting  and  the  binary  tree  sort  for  multi- 
sorting  [Ref .  11 ] . 

B.   MULTIPLE  SORTING 
1 .   Introduction 

A  system,  via  multiple  sorting,  executes  a  repeated 
sorting  of  the  data  matrix  according  to  successive  column 
numbers,  or  column  names  assigned  by  the  user  via  the  terminal. 

This  function  permits  nested  sorting  of  the  data  matrix 
The  concept  of  nested  sorting  is  clearly  illustrated  by  the 
following  example.   Suppose  we  have  the  data  matrix  as  in 
Fig.  5(a)  and  we  repeatedly  sort  it  according  to  the  columns 
4,  3,  2  and  1.   The  resultant  matrix  is  shown  in  Fig.  5(e) . 
In  this  matrix  the  first  four  rows  of  column  1  have  the  same 
value.   The  result  of  the  repeated  sorting  is  that  the  corres- 
ponding first  four  rows  of  column  2  (which  is  nested  to  column 
1  according  to  the  assigned  sorting  sequence  4,  3,  2,  1)  are 
sorted.   Likewise,  in  colume  3  the  rows  2,  3  and  4  have  the 
same  value  and  the  result  of  the  repeated  sorting  is  that  in 
column  4  the  avlues  in  rows  2,  3  and  4  are  sorted. 

The  concept  is  further  clarified  in  Fig.  6  where  direct 
sorting  of  the  data  matrix  is  presented  based  on  column  1 
(the  last  column  of  the  sequence  of  the  repeated  sorting) . 
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Fig.  5.   Nested  Sorting  of  the  Data  Matrix 
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Fig.    6.       Single    Sorting 
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The  result  is  a  matrix  sorted  in  column  1.   But  the  nested 
sorting  of  the  previous  case  does  not  exist. 

This  type  of  sorting  is  useful  in  cases  where  some 
variables  of  the  active  data  matrix  are  not  quantitative 
(continuous)  but  descriptive  (discrete)  and  are  attached  to 
classes  or  subclasses  of  data.   Successive  sorting  involving 
such  variables  organizes  the  matrix  in  a  corresponding  order 
if  the  collection  of  data  is  not  presorted  by  function  of  the 
classes  or  subclasses  (Fig.  7) . 
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Fig.  7.   Set  of  Data  Containing  Two  Classes  and 
Three  Subclasses 
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2  .   Principle 

Operation  of  the  repeated  sorting  of  the  data  matrix 
is  executed  in  two  phases.   The  first  phase  sorts  the  data 
matrix  consecutively  according  to  the  assigned  sequence  of 
column  numbers  or  names,  while  the  second  rearranges  the  rows 
of  the  initial  matrix  according  to  the  result  of  the  repeated 
sortings . 

a.   Phase  One 

The  virtual  process  by  which  the  repeated  sorting 
takes  place  is  the  following  (Fig.  8) : 

(1)  Read  the  first  column  according  to  which  the  data 
must  be  sorted.   Store  the  data  of  this  column  in  an 
array . 

(2)  Sort  the  array  and  get  the  invert  relative  addresses 
in  an  array  (NO) . 

(3)  Read  the  inverted  relative  addresses.   (This  means 
that  the  rows  are  rearranged  before  the  next  sorting.) 

(4)  Repeat  until  all  the  sorting  guides  have  been  used. 

In  order  to  avoid  rearranging  and  thus  to  save  process 
time  and  space  utilized,  the  following  method  is  used 
(Fig.  9) . 

A  one  dimension  array  (NOR)  is  used  to  store  the 

relative  addresses  in  which  the  data  file  will  be  read  and 

remains  unchanged  during  the  whole  process . 

(1)  Initialize  the  NOR. 

(2)  Read  the  first  column  in  which  storing  will  take  place. 
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(3)  Sort  the  column  and  get  the  inverted  relative  addresses 
(NO)  . 

(4)  Invert  the  NOR  according  the  NO. 

(5)  Repeat  until  all  sorting  guides  have  been  used. 

b.   Phase  Two 

The  second  phase  is  the  rearranging  of  the  data 
matrix  according  to  the  last  inverted  relative  addresses, 
using  the  same  external  file.   A  pictorial  presentation  of 
the  algorithm  used  is  shown  in  Fig.  10. 

The  reasoning  of  this  algorithm  is  the  following: 
In  Fig.  10  the  array  containing  the  inverted  relative  addresses 
is  noted  as  NOR.   The  first  pointer  of  NORl  is  pointing  to 
row  number  6.   This  means  that  row  6  must  move  to  the  first 
relative  address  of  the  matrix.   The  contents  of  this  address 
however  must  be  saved.   For  this  reason  a  mutual  exchange 
between  the  first  and  sixth  row  of  the  matrix  is  executed.   In 
this  way  the  first  row  already  contains  the  appropriate  values. 
A  consequence  of  this  exchange  is  that  the  first  row  which 
should  move  to  the  fourth  row  of  the  matrix,  is  now  moved  to 
the  sixth  position.   The  fourth  relative  address  therefore  of 
NOR  must  change  from  1  to  6 .   The  algorithm  searches  the  NOR 
from  1  to  8  until  it  locates  the  relative  address  1,  which 
exchanges  with  the  relative  address  6. 

Similarly,  in  the  second  step,  column  3  of  the 
matrix  must  move  to  the  second  relative  address.   Therefore 
a  mutual  exchange  between  rows  2  and  3  takes  place.   In  the 
NOR  now,  a  search  takes  place  until  the  relative  address  2 
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is  located.   This  occurs  in  the  eighth  position  and  therefore 
the  number  3  is  placed  at  the  eighth  position.   The  same 
process  is  repeated  until  all  the  rows  of  the  data  matrix 
are  rearranged  according  to  the  inverted  relative  addresses 
(NOR)  . 

The  choice  of  sorting  method  must  be  made  so  that 
the  expected  result  of  the  repeated  sorting  is  achieved.   In 
this  case  each  set  of  data  to  be  sorted  (the  data  of  a  column) 
is  not  independent  but  rather  is  bound  with  the  data  of  the 
other  columns  of  the  matrix.   Whenever  a  duplication  of  values 
appears  in  the  column  to  be  sorted,  these  values  must  not  be 
treated  equally  since  their  bound  with  the  values  of  the  neigh- 
boring columns  differentiates  them.   In  order  to  keep  the  order 
of  the  neighboring  columns  unaltered,  the  equivaled  entries 
of  the  matrix  must  maintain  their  order  after  sorting.   The 
following  example  clarifies  this  concept.   Suppose  that  we 
have  the  matrix  (a)  and  we  repeatedly  sort  it  according  to 
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columns  3,  2,  1,  considering  the  sequence  of  the  duplicate 
values  in  each  column,   The  resultant  matrix  in  Fig.  11  has 
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the  desired  property.   Repeating  the  same  sorting  but  not 
considering  the  sequence  of  the  duplicate  values,  the  result 
is  different,  as  illustrated  below: 
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The  above  consideration  imposes  limitations  in 
the  selection  of  the  sorting  method  to  be  used.   Considering 
only  the  speed  and  the  memory  space  consumed  in  the  method 
selecting  process  is  not  sufficient.   The  method  selected 
must  also  maintain  the  existing  order  of  the  equivaled  ele- 
ments.  Such  a  method  is  the  tree  sort. 

C.   TRANSFORMATIONS 
1 .   Introduction 

A  more  valid  analysis  of  row  statistical  data  usually 
requires  a  series  of  transformations  in  order  to  change  the 
scale  of  the  measurements . 

Initially,  a  test  of  normality  of  the  data  is  executed 
to  confirm  if  a  parametric  method  of  statistical  analysis  can 
be  used.   If  the  data  to  be  analyzed  are  non-normal,  normality 
can  be  obtained  by  applying  appropriate  transformations  on 
them  [Ref .  12] . 


45 


A  transformation  also  can  be  used  to  equalize  the 
variances  of  the  sample. 

a.   Fundamental  Transformations 

The  most  common  transformations  used  for  the 
purposes  mentioned  above  are  the  following. 

( 1)  Logarithmic  Transformation  (Neperian  and 
Common) . 

X'  =  Log(X)   for   X  >  0   or 
X'  =  Log  (X+C)   for   (X+C)  >  0 

If  considerable  heterogeneity  in  numbers  is 
present,  the  variance  is  often  found  to  be  correlated  with 
the  mean  level  on  a  square  root  scale,  and  may  only  be  stabi- 
lized if  transformation  is  made  to  the  logarithmic  scale 
[Ref .  13]  . 

(2)  The  Inverse  Sine  or  Arcsine  Transformation. 


X'  =  Sin  1(SQRT(X))  =  Arcsin (SQRT ( X) )   if   0.  <=  X  <=  1 


This  transformation  permits  an  equalization 
of  variances  when  the  data  are  proportions  or  ratios. 
( 3)   The  Square  Root  Transformation. 

X'  -  SQRT(X)   if   X  >=  0 
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This  transformation  is  used  when  the  vari- 
ances of  the  samples  are  approximately  proportional  to  their 
mean,  or  when  the  data  follow  the  Poisson  distribution. 

( 4)  The  Inverse  Transformation. 

X'  =  1/X   if   X   is  different  than  zero 

This  transformation  is  used  to  equalize  the 
variances  whenever  they  are  approximately  proportional  to 
x  ,  x  ,  . . . ,  (x:  mean) . 

( 5)  The  Inverse  Hyperbolic  Sine  or  Arcsine 
Hyperbolic  Transformation . 


X'  =  Sinh  1(SQRT(X))  =  Arcsine ( SQRT ( X) 


where 

Arcsine  (Z)  =  Log  (|z|  +  Z*Z+1) 

( 6)   Exponentiation  at  Tth  Transformation 


T 
X  '  =  X 


This  transformation  is  suggested  by  Snedecor 
and  Cohran  (1967)  for  variance  analysis  when  there  is  no 
additivity  of  variances  [Ref.  14]. 
b.   Complex  Transformations 

Although  the  above  transformations  are  the  most 
commonly  used,  the  system  provides  an  ability  for  any  kind  of 
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transformation  assigned  by  the  user  in  the  form  of  an  ex- 
pression via  the  keyboard.   In  this  way,  not  only  is  a  trans- 
formation of  the  column  obtained,  but  calculations  at  run  time 
involving  intrinsic  functions,  arithmetic  operators,  con- 
stants (integers  or  reals)  and  data  contained  in  the  data 
matrix,  can  be  performed  according  to  user  assigned  mathemati- 
cal expression.   Examples  of  such  expressions  are: 

•  SQRT[7]/[5]  •        (LOG[10]/2)   "2 

[9]     +    3.14 

•  SIN[5]     -     (-COS [3]) "3 

The  number  of  the  column  must  be  enclosed  in 
brackets  in  order  to  be  identified,  while  the  symbol  "~"  is 
used  for  the  operation  of  exponentiation  to  avoid  use  of  two 
characters  as  an  operator. 

The  value  of  each  assigned  transformation  is 
considered  as  a  new  column  or  parameter  and  is  placed  at  the 
rightmost  of  the  columns  —  increasing  by  one  the  number  of 
columns  of  the  data  matrix. 
2 .   Principle 

a.   Breakdown  of  the  Expression  in  Parts 

The  inserted  expression  is  read  as  a  unique 
character  string  and  is  broken  down  into  the  following  kinds 
of  characters  or  character  strings: 

Functions  and  corresponding  column  number  (e.g., 

TAN [ 2 ] ) 

Column  number  (e.g.,  [5]) 
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Real  number  or  integer 

All  the  above  with  negative  signs 

Operators  (+,  -,  *,  /,  ") 

")  " 

For  example,  the  expression  ( COS [ 3 ] +2 . 7 ) / ( - [ 5] )  " !■ 
is  broken  down  as  follows: 
( 

COS  [3] 
+ 

2.7 
) 

/ 
( 
-  [5] 


In  this  format  the  elements  constitute  an  infix 
notation  format.   After  the  breakdown,  the  elements  are 
stored  in  a  two  dimensional  one  character  array  INF.   Three 
one  dimension  one  character  arrays  FUN,  NUM  and  CONS  are  used 
for  temporary  storage  of  the  functions  with  their  corresponding 
column  number  arguments,  column  numbers,  and  constants. 
Three  flags--TEST,  MARK  and  INDEX--are  used  to  signal  the 
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existence  of  a  negative  value.   This  negative  value  is  iden- 
tified whenever  a  "-"  character  follows  an  "("  character. 
The  variable  BR  is  used  to  temporarily  store  a  "["  or  "]" 
character  which,  in  combination  with  the  flags,  permits  a 
column  number  to  indicate  that  the  datum  of  the  value  will 
be  used  in  the  expression  or  that  the  value  is  an  argument  of 
a  function. 

b.   Conversion  from  Infix  to  Postfix  Notation 

The  method  used  for  evaluation  of  the  expression 
requires  the  transformation  of  the  infix  expression  (which 
is  the  normal  form  used  by  mathematics)  into  postfix  notation 

A  postfix  notation  is  a  rearrangement  of  the 
characters  of  the  infix  expression  to  remove  the  ambiguity 
of  which  operator  is  performed  first--using  parentheses  to 
indicate  the  priority  of  the  operators.   For  example,  the 
expression  a+b*c  is  ambiguous  since  it  is  not  clear  if  the 
addition  or  the  multiplication  has  to  be  performed  first. 
This  ambiguity  requires  the  use  of  parentheses  to  specify  the 
operation  to  be  performed  first. 

In  a  postfix  notation,  all  the  information  re- 
quired for  the  evaluation  of  the  expression  is  included  in 
it.   Moreover,  the  parentheses  are  not  required  any  more. 

Suppose  that  we  have  to  evaluate  the  expression 
a+b*c+ (d/e-f ) .   For  its  evaluation  two  facts  are  used  t< 
determine  the  sequence  of  the  operations.   First  is  th< 
existence  of  the  parentheses  which  define  which  expression 
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has  to  be  performed  first.   The  result  has  to  be  used  as  a 
new  value  for  the  remaining  evaluation  of  the  expression. 
Second,  the  precedence  of  the  operators.   Operation  of  the 
exponentiation  is  to  be  performed  first,  then  the  multiplica- 
tion and  division  and  finally  the  addition  and  subtraction. 
Therefore,  in  the  expression  in  parentheses,  the  division 
has  to  be  performed  before  the  subtraction  while  in  the  part 
outside  of  the  parentheses,  multiplication  is  to  be  performed 
before  addition. 

The  same  expression  in  postfix  notation  is: 
abc*+de/f-+.   This  form  does  not  need  the  conventions  mentioned 
above,  in  order  to  be  evaluated.   Each  operator  simply  uses 
the  two  operands  preceding  it,  in  a  left  to  right  sequence. 

The  method  used  for  the  conversion  from  infix  to 
postfix  is  the  push-down  stack  for  the  storage  of  the  operators 
and  parentheses  of  the  expression. 

In  general  terms,  the  algorithm  used  is  as  follows: 
Each  character  of  the  expression  is  examined.   If  it  is  an 
operand  it  is  placed  directly  in  the  created  postfix  form. 
If  it  is  an  operand,  then  if  the  topmost  character  of  the 
stack  is  an  operator,  priority  comparison  takes  place.   If 
the  operator  of  the  stack  has  equal  or  higher  priority,  it 
is  popped,  and  placed  in  the  postfix  expression,  while  the 
other  is  pushed  into  the  stack.   If  the  priority  of  the  stack 
operator  is  lower,  the  other  is  pushed  into  the  stack.   If 
the  character  of  the  infix  expression  is  an  "(",  it  is  pushed 
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into  the  stack,  while  if  it  is  a  ") ",  the  topmost  operator  is 
popped  and  placed  in  the  postfix  and  the  two  parentheses  are 
ignored.   Fig.  11  gives  a  pictorial  view  of  the  algorithm 
described. 

In  order  for  the  procedure  to  be  included  in 
the  transformations  of  the  developed  software  package,  the 
following  considerations  must  be  taken. 

The  operands  can  be  positive  or  negative: 
Functions,  e.g.,  SQRT[7]  (square  root  of  the  column's 
seven  value) 

Column  number  enclosed  in  brackets,  e.g.,  [3]  (the  value 
of  column  three) 
Numerical  values  (real  or  integers) . 

The  above  considerations  require  the  statement 
of  the  expression  in  character  form.   In  this  way,  the  several 
kinds  of  operands  can  be  distinguished  and  treated  appro- 
priately.  The  produced  postfix  expression  is  stored  in  a 
two  dimensional,  one  character  array. 

Suppose  that  we  have  the  infix  expression: 

(COS[3]+2.7)/(- [5] '2-8 

The  resultant  postfix  expression  is  illustrated  in  Fig.  12 
as  it  appears  stored  in  the  array  POST. 
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Postfix  exoression 


Stac^ 


Infix  expression 


a-fa'c* (d/e-f) 


+b*c+(d/e-f ) 


b*c*(d/e-f ) 


ab 


~V^ 


■c+(d/e-f ) 


ab 


c+(d/e-f ) 


abc 


~V 


+(d/e-f ) 


abc' 


~V 


+(d/e-f ) 


abc*  + 


(d/e-f ; 


abc*  + 


d/e-f) 


Fig.  11.   Infix  to  Postfix  Conversioi 
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abc*+d 


~V^ 


/e-f ) 


abc*+d 


/ 
( 

+ 


e-f) 


abc*+de 


-f  ) 


abc**de/ 


f  ) 


abc*+de/ 


f) 


abc*+de/f 


"~V~ 


abc*+de/f- 


"^~ 


abc*+de/f-+ 


^v-~ 


Fig.     11.        (CONTINUED) 
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COS 
2    .    7 


/ 


Fig.  12.   Representation  of  the  Postfix  Expression 

c.   Evaluation  of  the  Postfix  Expression 

As  previously  mentioned,  evaluation  of  the  expres- 
sion after  its  transformation  into  postfix  notation  has  been 
simplified . 

The  procedure  used  is  as  follows: 

a)  Scan  the  postfix  expression  and  push  into  the  stack 

the  encountered  operands  until  an  operator  is  encountered 

b)  Pop  the  two  topmost  operands  of  the  stack,  apply  the 
operator  to  them  and  push  the  result  into  the  stack. 

c)  Repeat  until  the  end  of  the  postfix  expression.   The 
example  given  in  Fig.  13  illustrates  the  concept. 

To  implement  the  above  procedure,  the  "-"  sign 
of  a  negative  number  has  to  be  considered,  and  be  distinguished 
from  a  "-"  operator.   This  task  is  served  by  representation 
of  the  postfix  expression  as  shown  in  Fig.  12. 
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STACK  OPERATION  POSTFIX 

OPl    OPERATOR    OP2 

3,5, 2,*, +,10,2,/, 1,-,+ 
3  5,2,*,+,10,2,/,l,-,+ 

3,5  2,*,+,10,2,/,l,_,+ 

3,5,2  *,+,10,2,/,l,_,+ 

5  *       2 

3,10  +,10,2,/,l,-,+ 

3  +10 

13  10,2,/,l,-,+ 

13,10  2,/,l,-,+ 

13,10,2  /,!,-,+ 

10  /       2 

13,5  1,-,+ 

13,5,1  -,+ 

5  1 

13,4  + 

13  +4 

17 


Fig.  13.   Evaluation  of  a  Postfix  Expression  Using  the 
Expression  of  the  Previous  Example: 
a+b*c+(d/e-f) 
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For  each  line  of  the  array  POST: 
If  the  first  character  is  a  letter,  or  number,  or  "[", 
the  element  is  treated  as  an  operand. 
If  the  first  character  is  "  +  '*  ,  "  * "  ,  "/",  """,  it  is 
treated  as  an  operator. 

If,  however,  the  first  character  is  "-",  then  the  second 
character  is  examined. 

If  it  is  a  letter,  number  or  " [",  the  element  is 

treated  as  a  negative  operand. 

If  it  is  a  "  ",  then  it  is  the  minus  operator. 

Each  of  the  three  kinds  of  operands  is  identified, 
stored  in  a  one  dimension  array  and  evaluated  appropriately. 
The  numeric  characters  must  be  decoded  before  an  arithmetic 
operation  is  applied  to  them. 

D.   RANDOMIZATION 

1 .   Introduction 

The  system  provides  a  randomization  ability  of  the 

data,  needed  in  the  following  cases: 

Many  observations  (data)  are  collected  as  a  function  of 
time.   In  order  to  avoid  any  correlation  influencing  the 
way  this  data  is  collected,  we  can  randomly  burst  the 
order  of  the  rows  of  the  data  matrix. 

When  multiple  sorting  is  desired  and  some  of  the  columns 
are  already  sorted.   This  fact  will  have  negative  results 
in  the  performance  of  the  sorting  method  used  by  the 
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system  (tree-sort)  to  obtain  the  multiple  sorting  (see 
Section  II. B)  .   In  cases  where  the  amount  of  data  is 
large,  it  is  preferable  for  randomization  of  the  sorted 
columns  to  take  place  before  multiple  sorting. 
2 .   Principle 

The  randomization  of  the  data  is  obtained  by  reading 
it  as  they  are  ordered  and  rewriting  it  according  to  a  sequence 
of  random  numbers  produced  by  the  function  RANDAN. 

The  principle  used  is  a  congruential  method  of  seg- 
menting the  modular  arithmetic,  described  by  K.D.  Senne  (1974) 
and  the  algorithms  are  given  by  D.  Guinier  (1984)  [Ref.  3] . 

For  all  m  bit  generators,  a  sequence  of  integers  L(n) 
in  the  interval  {0,2**m-l}  is  calculated.   The  desired  real 
variables  Xn  are  obtained  from  the  L(n) 's.   The  next  sequence 
of  the  L(n+1) 's  are  calculated  by  dividing  the  L(n) 's  by 
2**m  by  the  formula:   L(n+1)  =  (A*L(n)+B)  mod  2**m. 

M.  Abramowitz  and  I. A.  Stegun  (196  5)  have  proven  many 
successful  combinations  for  A,  B  and  m,  e.g.,  A  =  R*2**S+/-1, 
where  S  is  equal  or  greater  than  2  and  B  =  0 . 

The  multiplier  R  is  selected  so  that  the  number  of 
significant  bits  in  R*2**S+/-1  is  approximately  m.   L(n+1) 
is  the  next  cycle.   There  is  no  correlation  between  adjacent 
numbers:   L's,  ( Ll , L2 , L3 , . . . , Lq-1 , Lq) . 

If  S  =  3,  let:   A  =  8*R-1;  or  any  m  bits  A  in  which 
the  last  three  bits  equal  1. 

The  L(n) 's  can  be  segmented  into  q  integer  parts  by 
the  arithmetic  expression  for  any  m  bit  number: 


L(n)  =  f (Ll,L2,L3, . . . ,Lq-l,Lq) ,  that  is: 
L(n)  =  Ll*2**(m*(q-l)/q) 

+  L2*2**(m* (q-2)/q) 

+  .  .  . 
+  Lq*2**0 
and  A  can  be  segmented  in  the  same  way: 
A  =  f (Al , A2 , A3 , . . . , Aq-1 ,Aq) ,  that  is: 
A  =  Al*2***m*(q-l)/q) 

+  A2*2** (m*(q-2) /q) 
+  .  .  . 
+  Aq*2**0 
Set  L(n+1)  =  A*L(n)+B,  that  is,  if  B  =  0:   L(n+1)  =  A*L(n) 
A*(n)  =  (Al    *L1         ) *2**(2*m*(q-l)/q) 
+  (Al    *L2+A2*L1   ) *2**(2*m*(q-2)/q) 
+  .  .  . 

+  (Aq-1) *Lq+Aq*Lq-l) *2** ( 2 *m       /q) 
+Aq     *Lq  *2**0 

The  previous  operations  are  performed  in  Part  I  of 
Algorithm  I : 

Algorithm  I 
c=0 
k=q 

DO  WHILE  (k.GT.O) 
i=0 
p=0 
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PART  1 :  Calculation  of  products   A*L(n) : 
For  any  L(n) 
DO  WHILE  (i.LE.q-k) 
p  =  p+Ai+k*L(n) q-1 
i  =  i+1 
END  DO 
PART  2 :  Actualization  of  the  L(n) 's  in  L(n+1) 's,  by  performing 
the  operation  modulo  2.**[m/q]  : 
p        =  p+c 
c        =  p   /(2.** [m/q]) 
L(n+1) i  =  p-c*(2.** [m/q] ) 
k  =  k-1 
END  DO 

After  we  take  the  modulus  relative  to  2**m,  for  the 
next  cycle  of  Ln ' s ,  the  expression  is  given  by  Part  2  of 
Algorithm  I . 

When  we  take  the  modulus  2.**m  of  the  previous 
products  A*L(n) ,  it  gives: 

L(n+1)  =  {  (Al*Lq+A2*Lq-l+.  .  . +Aq*Ll ) mod2 *  * (m/q)  }2** (  (2*m/q)  *  [q/2]  ) 
+(A2*Lq+A3*Lq-l+.  .  .+Aq*L2)  *2**(  (  (2*m/q)  *(  [q/2 -2)  ) 
+. . .+Aq*Lq*2**0   and, 

-  the  second  half  of  the  last  term  is:  L(n+l)q, 

-  the  remainder  of  the  last  term  +  the  second  half  of 
the  next  to  the  last  term  is:  L(n+l)q-l,. 

-  the  remainder  of  the  next  to  the  last  +  the  second 
half  of  the  term  just  before  the  next  to  the  last 
term  is:  L(n+l)q-2,  etc. 

60 


Ak  and  Lk  are  defined  for  k  =  1  to  q  pieces  at  the 
beginning  of  the  sequence. 

The  maximum  precision  requires  2*m/q  bits  for  the 
update  plus  carry  over  bits  to  add  q  numbers  of  length  2*m/q 
and  a  number  of  length  m/q ,  i.e., 

p  =  [log2{q**( (2*m/q) -1**2) +2** (m/q) -1}]+1  bits. 

The  number  q  of  possible  pieces  for  a  36  bit  pseudo- 
random number  (m  =  36)  is:   2,  3,  6,  9,  12,  18  or  36.   We 
take  q  =  6  for  a  15  bit  positive  integer  INTEGER*2,  up  to 
2**15-1,  i.e.,  32767.   The  cycle  length  of  the  generator 
has  been  tested  greater  than  10**7. 

The  sequence  of  the  x's  is  obtained  from  the  following 
algorithm. 

Algorithm  II 
i  =  0 
x=0 
DO  WHILE  (i.LT.q) 

i=i+l 

x=x+L(n+l) i*2 .** (- [m/q] *i) 
END  DO 
and  the  next  L(n)  's  will  be  the  actual  L(n+1)  's  for  the  next 
sequence.   The  initial  sequence  is  forced  into  a  flag  if 
it  is  different  than  zero  ( IND) . 
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Ill .   DIRECTIONS  FOR  USE  OF  THE  I DAMAN 

A.  INTRODUCTION 

The  system  I DAMAN  is  an  interactive  and  conversational 
system  intended  to  be  used  by  any  user  regardless  of  his/her 
level  of  programming,  and  without  any  specific  knowledge  or 
training  requirements.   For  this  reason  an  effort  was  made 
for  the  system  to  be  self -directed  via  meaningful  screen 
displayed  prompts. 

The  IDAMAN  operates  through  five  environments  of  operation. 
The  transition  from  one  environment  to  another  is  obtained 
by  the  carriage  return  (<CR>) .   In  each  environment  appro- 
priate prompts  and  menu-like  tables  are  displayed  directing 
the  use  of  the  system.   The  five  environments  are  the  following 

MODES  OF  OPERATION 

COLUMN  INFORMATION 

ROW  INFORMATION 

COLUMN  MODIFICATION 

ROW  MODIFICATION 

B.  MANAGING  DATA  FILES 

The  data  is  stored  in  direct-access  unformatted  files  in 
mass  storage.   These  files  have  names  of  the  form:   FORxxx.DAT; 
where  xxx  is  a  key  number  for  the  particular  file.   During 
the  manipulation  of  the  data,  the  system  requests  the  key 
number  of  an  existing  file  on  which  the  data  to  be  manipulated 
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is  stored  or  a  new  one  on  which  the  manipulated  data  will  be 
stored.   This  request  is  done  by  the  prompt: 


Assign  the  'OLD'  direct  access  file: 

Key(xxx)  For  File  FORxxx.DAT  number  y,  (nnn=069 


and  the  user  has  to  assign  a  numeric  or  alphanumeric  three 
digit  key.   The  number  y  indicates  the  logical  unit  number 
used  for  this  file  (in  the  example  given  by  the  prompt,  the 
key  number  is  069) . 

C.  USER  ERROR  PREVENTION 

The  program  has  been  designed  in  such  a  way  that  the 
most  common  user  errors  can  be  prevented  by  an  error  message 
reaction  of  the  program  instead  of  a  run  time  compiler  error 
After  the  appearance  of  the  message,  the  program  shifts  to 
the  appropriate  position  for  reassignment  of  the  erroneously 
given  information. 

D.  SELECTING  MODE  OF  OPERATION 

Access  of  the  first  environment  is  obtained  by  the  execu- 
tion of  the  program  and  permits  the  selection  of  one  of  the 
available  modes.   The  selection  of  the  desired  mode  is  ob- 
tained by  assigning  the  corresponding  number  of  the  mode  as 
it  appears  in  the  following  table: 
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AVAILABLE  MODES 

Creation  of  new  header  :1 

Display  of  existing  header  :2 

Modification  of  existing  header  : 3 

Merging  of  two  existing  headers  :4 

Answer  : 


E.   THE  FUNCTION  OF  MODES  AND  HOW  TO  DEAL  WITH  THEM 
1  .   Creating  a  New  Header 

The  creation  of  a  new  header  is  done  by  selecting 
mode  1.   Upon  entering  this  mode  the  following  prompt  appears 
on  the  screen : 


Name  of  header's  file 


and  requests  the  assignment  of  any  24  character  string  which 
will  be  used  as  the  file  name  of  the  sequential  file  in 
which  information  of  the  created  header  will  be  stored. 
After  file  name  assignment,  the  prompt: 


Column  information 
Row  information 
Answer 


requests  the  environment  to  be  used  next.   By  selecting  1, 
the  program  enters  the  environment  in  which  information 
regarding  the  columns  of  the  header  will  be  assigned,  while 
2  permits  assignment  of  information  related  to  the  rows  of 
the  header. 
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2 .   Assigning  Information  for  the  Columns 

Upon  entering  the  environment  for  column  information, 
the  following  menu-like  table  appears  on  the  screen: 

SELECTION  TABLE  FOR  COLUMN  INFORMATION 


Number  of  columns  (mandatory) 
Mnemonic  names 
Transformations 
Tracing  extrema 
Multi-sorting  column  guides 
Randomization  of  data 
Column  ranking 
Display  column  information 
Modification  of  column  info 
Data  retrieval 
Display/print  of  data  file 


1 
2 
3 
4 

5 

6 

7 

8 

9 

10 

11 


The  selection  of  each  entry  of  the  table  permits  the  assign- 
ment of  the  corresponding  information.   At  the  end  of  each 
assignment,  the  program  returns  for  new  column  information. 
The  exit  of  this  environment  is  obtained  by  <CR>.   The 
process  for  each  assignment  is  as  follows, 
a.   Number  of  Columns 

Selecting  this  entry  is  mandatory  for  the  opera- 
tion of  the  program.   The  following  prompt  appears  on  the 
screen : 


Assign  number  of  columns  : 


The  only  action  of  the  user  is  the  assignment  of  the  number 
of  columns  of  the  data  matrix.   The  maximum  number  of  columns 
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permitted  by  the  present  design  of  the  program  is  128--which 
can  easily  be  changed  by  a  simple  modification, 
b.   Mnemonic  Names 

The  selection  of  this  entry  of  the  table  permits 
the  assignment  of  mnemonic  names  to  columns  of  the  data 
matrix.   The  prompt  appearing  on  the  screen  this  time  is: 


Assign  column  number  (<CR>  to  RETURN)  : 

requesting  the  number  of  the  column  for  the  next  mnemonic 
name  to  be  assigned.   After  the  assignment  of  the  column 
number,  the  prompt  appearing  is: 


Assign  mnemonic  name 


requesting  the  name  for  the  assigned  column  number.   The 
assignment  of  column  names  is  not  necessarily  done  in  ascend- 
ing order  of  column  numbers;  neither  is  it  necessary  to  assign 
names  to  all  columns.   The  program  sorts  the  assigned  column 
numbers  in  order,  to  appear  in  the  display  of  the  header's 
data  in  the  proper  order.   <CR>  terminates  the  assignment  of 
names . 

c.   Transformations 

IDAMAN  uses  this  function  to  permit  any  number 
and  kind  of  mathematical  expression  involving  values  of  the 
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data  matrix  to  be  assigned.   In  this  way  a  transf orir.ation  of 
the  value  according  to  the  assigned  expression  is  obtained. 
The  value  of  each  expression  (calculated  for  each  row)  is 
considered  as  a  new  column  of  the  header  and  of  the  data 
matrix.   The  result  of  the  transformation  is  attached  to  the 
rightmost  end  of  the  columns  as  a  new  column.   The  total 
number  of  the  original  columns  plus  the  number  of  columns 
created  by  transformations  should  not  exceed  the  maximum 
permitted  number  of  12  8. 

The  function  of  the  transformations  is  better 
explained  by  the  following  example.   Suppose  that  the  initial 
data  matrix  to  be  transformed  is: 


2  .2 

5.3 

9  .0 

0.3 

3.0 

1.2 

4.0 

1.5 

1.1 

6.7 

16.0 

23.5 

12.3 

3.0 

1.0 

3.5 

0.0 

1.0 

0.0 

1.0 

4  .4 

5.0 

4  .0 

8.7 

with  NCOL=4   NROW=6   and  the  assigned  transformation  is 
SQRT[3]/2.   This  means  that  the  column  to  be  transformed  is 
the  third,  and  the  transformation  will  be  the  square  root 
of  its  value,  and  then  dividing  the  result  by  2.   The  new- 
data  matrix  will  have  NCOL=5  and  will  be: 
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2.2 

5  .  3 

9  .0 

0  .3 

1.5 

3.0 

1.2 

4.0 

1.5 

1.0 

1.1 

6.7 

16  .0 

23.5 

2.0 

2.3 

3.0 

1.0 

3.5 

0.5 

0.0 

1.0 

0  .0 

1.0 

0  .0 

4  .4 

5.0 

4  .0 

8.7 

1.0 

The  form  of  the  assigned  transformation  can  be 
any  algebraic  expression  involving  values  of  the  data  matrix, 
any  real  or  integer  constant  value,  and  values  resulting 
from  the  application  of  the  following  functions,  assigned  by 
its  number  column: 

LOGC   Common  logarithm. 

LOG    The  natural  logarithm. 

EXP    Exponential . 

ABS    Absolute  value. 

SIN    Sine. 

COS    Cosine. 

TAN    Tangent. 

ASIN   Arc  sine. 

ACOS   Arc  cosine. 

ATAN   Arc  tangent. 

SINH   Hyperbolic  sine. 

COSH   Hyperbolic  cosine. 

TANH   Hyperbolic  tangent. 

SQRT   Square  root. 

ASINH  Arc  sine  hyperbolic. 
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The  column  number  for  which  the  value  will  be  substituted 
for  in  calculating  the  expression,  must  be  enclosed  in 
brackets  ([])  in  order  to  be  recognized  by  the  program.   The 
notion  of  exponentiation  is  shown  by  the  character,  "~" .   All 
functions  assigned  in  an  expression  must  be  in  upper  case 
letters  in  order  to  be  recognized  by  the  program.   The  follow- 
ing are  some  examples  of  expressions  that  can  be  assigned  as 
transformations  of  columns : 
[3]+3.14 

•  SQRT[7] 
(SIN[5]+3.14)  A2 

•  LOG[10]-( [12]*(-SQRT[2])~3 
(  (COS [15]+3.14)/ [4]  )  *5. 23 

At  the  end  of  the  expression ( s)  assignment,  the  file  name 
in  which  the  data  to  be  transformed  are  stored,  must  be 
assigned . 

d.   Tracing  Extrema 

By  this  function,  IDAMAN  permits  the  assignment 
of  a  range  of  values  in  which  all  existing  values  in  the 
data  matrix  will  be  used  for  tracing.   This  area  is  defined 
by  its  lower  and  upper  boundaries  (extrema) .   Upon  selecting 
the  corresponding  entry  of  the  selection  table,  the  program 
requests  the  name  of  the  file  on  which  the  data  are  stored, 
in  order  to  determine  the  existing  maximum  and  minimum  values 
of  each  column.   These  values  are  used  for  tracing  in  the 
case  that  not-user  defined  extrema  are  desired.   The  extrema 
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are  displayed  during  assignment  to  facilitate  the  work.   The 
next  assignment  is  the  type  of  extrema  that  will  be  used. 
That  is  the  purpose  of  the  prompt: 


Imposed  extrema  for  tracing  :1 
Original  extrema  :0 


Selecting  0,  the  program  automatically  will  use  the  minimum 
and  maximum  values  of  each  column  as  tracing  extrema. 
Selecting  1,  the  user  is  requested  to  assign  the  column 
number  for  the  tracing  extrema,  by  the  following  prompt: 


Assign  column  number  (<CR>  to  RETURN! 


The  prompt  for  exrema  assignment  continues: 


MIN  (found) :         Imposed: 
MAX  (found) :         Imposed: 


The  program  displays  the  existing  minimum  and  maximum  values 
of  each  column.   The  user  thus  assigns  his/her  different 
imposed  extrema. 

e.   Multi-sorting  Column  Guides 

Multi-sorting  column  guides  allow  the  system  to 
assign  a  series  of  columns  according  to  which  multiple  sorting 
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will  take  place.   For  details  on  multiple  sorting,  see 
Section  II. B.   The  assignment  of  the  columns  that  will  be 
used  as  guides  for  the  sorting  can  be  done  by  the  column 
numbers  or  by  their  mnemonic  names.   The  following  prompt 
requests  the  user  to  assign  the  desired  mode  of  assignment 


By  column  numbers  :1 
By  mnemonic  names  :2 
Answer  : 


By  selecting  1,  the  following  prompt  will  appear 


Assign  nc(s) .  of  columns  : 


The  assignment  of  sorting  guides  can  be  a  series  of  column 
numbers  separated  by  a  "comma"  or  two  numbers  separated  by 
a  "colon"  meaning  that  all  the  numbers  contained  therein 
will  be  used  as  multiple  sorting  guides.   If,  for  example, 
18,13,5  is  assigned,  the  data  will  be  sorted  according  to 
column  18,  then  according  to  column  13,  and  finally  according 
to  column  5.   If  5:8  is  assigned,  the  data  will  be  sorted 
according  to  column  5,  then  according  to  column  6,  then 
column  7,  and  finally  column  8.   If  the  assigned  series  of 
columns  exceeds  one  screen  line,  the  assignment  can  continue 
to  the  next  screen  line  by  using  a  "comma"  as  a  continuation 
mark.   In  the  case  that  assignment  of  sorting  guides  using 
mnemonic  names  is  desired,  the  prompt: 
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Assign  column  mnemonic  names  : 

will  provide  it.   In  this  case  the  names  must  be  assigned  one 
in  each  screen  line.   After  printing  the  name  of  the  column, 
the  carriage  return  (<CR>)  will  enter  the  name  in  the  computer 
while  the  cursor  will  move  to  the  next  screen  line  for  the 
next  name  assignment. 

f.  Randomization  of  Data 

By  this  operation,  the  system  permits  randomization 
of  the  data  for  improvement  of  the  sort  method  performance 
or  for  elimination  of  the  time  effect.   The  only  assignment 
for  this  operation  is  the  name  of  the  file  on  which  the  data 
are  stored.   This  assignment  is  done  as  soon  as  the  prompt 
requesting  the  name  of  the  file  appears  on  the  screen  (see 
Section  III .B) . 

g.  Column  Ranking 

A  new  arrangement  of  the  columns  assigned  by  the 
user  is  permitted.   This  assignment  can  be  done  by  column 
numbers  or  column  names.   Upon  selection  of  the  operation, 
the  prompt : 


By  column  numbers  :1 
By  mnemonic  names  : 2 
Answer  : 


requests  the  desired  assignment  mode.   If  the  mode  is  the 
first  one,  the  prompt: 
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Assign  no(s)  of  columns: 

requests  the  assignment  of  a  series  of  column  numbers  which 
will  be  used  for  the  new  ranking.   This  assignment  is  done  as 
described  in  Section  III.B.   The  assignment  of  columns  with 
mnemonic  names  is  also  done  as  in  Section  III.E.2.e,  after  the 
prompt : 


Assign  ranking  by  sequence  of  names  : 

appears  on  the  screen. 

The  operation  of  ranking  creates  a  new  data  file 
The  number  of  columns  used  for  the  ranking  assignment  is 
the  number  of  columns  of  the  new  data  matrix, 
h.   Display  of  Column  Information 

Display  of  column  information  shows  assigned 
information  related  to  the  columns  of  the  header, 
i.   Modification  of  Column  Information 

By  this  operation,  the  program  passes  to  the 
environment  for  modification  of  information  related  to  the 
columns.   This  is  a  modification  of  information  assigned  by 
the  current  run  of  the  program.   As  mentioned  above,  the 
modification  of  a  header  created  by  another  run  and  existing 
in  a  file,  is  done  by  another  mode  of  the  program.   Upon 
selecting  the  modification  operation,  the  table: < 
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MODIFICATION  SELECTION  TABLE 


Number  of  columns 
Mnemonic  names 
Tracing  extrema 
Sorting  guides 
Rank  of  columns 
Answer 


permits  selection  of  the  desired  modification.   The  several 
modifications  are  executed  with  the  same  kind  of  conversa- 
tional mode.   The  old  information,  which  are  candidates  for 
modification,  appear  on  the  screen  to  facilitate  the  work. 
In  case  that  modification  is  attempted  for  information  that 
has  not  been  assigned,  the  program  reacts  with  a  message 
informing  the  user  to  assign  the  information.   The  following 
prompts  appear  for  the  corresponding  modification  selections 
(1)   Number  of  Columns. 


Old  number  of  columns 
Assign  new  number 


(2)   Mnemonic  Names 


Assign  column  number  : 


Upon  the  assignment  of  column  number  for  the 
mnemonic  name  which  will  be  modified,  the  prompt: 
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Old  name         : 
Assign  new  name  : 


facilitates  the  modification. 

(3)   Tracing  Extrema .   The  prompt 


Assign  column  number 


requests  the  number  of  the  column  for  which  the  tracing 
extrema  will  be  modified  and  in  following  the  prompts: 


Old  MIN 

Assigns  new  MIN 
Old  MAX 
Assign  new  MAX 


permits  the  modification  of  the  displayed  old  extrema. 

(4)   Sorting  Guides.   Selecting  modification  of 
the  multi-sorting  column  guides,  the  old  ones  (column  number; 
or  mnemonic  names)  are  displayed  initially,  and  then  the 
prompts : 


or 


Assign  no(s)  of  columns 


Assign  mnemonic  names 
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requests  new  column  assignment  by  numbers  or  mnemonic 
names . 

(5)   Rank  of  Columns.   Modification  of  the  ranking 
assignment  is  similar  to  modification  of  multi-sorting  guides. 
The  difference  is  that  the  number  of  columns  must  be  modified 
before  the  modification  of  the  ranking  assignment  in  order 
to  be  consistent  with  the  initial  data  matrix. 
j .   Data  Retrieval 

By  this  operation,  the  program  searches  the  data 
file  for  a  specific  value  assigned  by  the  user  or  for  a 
missing  value  represented  by  a  "gold"  value,  and  informs  the 
user  about  them  as  explained  below.   The  process  for  the 
assignment  of  this  operation  of  the  program  is  as  follows: 


Name  of  the  existing  data  file  : 

requests  the  key  number  of  the  data  file  which  is  going  to 
be  searched.   The  next  prompt: 


Assign  device  (or  file)  : 


permits  the  user  to  assign  where  he/she  desires  to  receive 
information  (terminal  or  file) .   The  amount  of  file  to  be 
searched  is  also  assigned  by  the  user  with  determination  of 
columns  and  rows  of  the  data  matrix.   This  is  done  after  the 
appearance  of  prompts : 
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Assign  no(s) .  of  columns 


and 


Assign  no(s) .  of  rows 


The  assignment  can  be  done  by  the  symbol  "*"  meaning  "all", 
by  any  alphabetic  character,  by  sequence  of  column  or  row 
numbers  separated  by  a  comma  (",")  (e.g.,  2,5,36)  which 
determines  specific  columns  and  rows,  or  by  two  numbers 
separated  by  a  colon  (":")  which  determines  all  columns  or 
rows  included  between  the  two  numbers.   The  prompt  that  follows 


Data  to  be  retrieved  (real  or  "gold")  : 

permits  the  assignment  of  the  real  value  to  be  searched. 
The  letter  "g"  or  "G"  determines  that  the  program  must 
search  for  missing  values  which  are  represented  by  the 
number  12345.678  or  any  number  that  can  be  assigned  by  the 
user  with  the  next  prompt: 


Change  or  RETURN  : 

The  data  provided  by  the  program  after  completion  of  the 
search  is  the  Index  (sequence  number  of  the  element  in  the 
matrix) ,  the  column  number,  the  row  number  and  the  value. 
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k.   Display/Print  of  Data  File 

For  the  data  file  to  be  displayed,  information 
regarding  its  name,  the  device  on  which  it  will  be  printed 
or  displayed,  the  numbers  of  columns  and  rows  that  will  be 
printed  or  displayed  are  requested  as  in  Section  lll,E.2.e 
The  format  of  the  data  values  is  also  the  object  of  user's 
specification.   It  follows  the  prompt: 


The  normal  format      :  nnnnnnnn . nnnnnn 

To  modify  it  assign  your  format  (ex.nnn.nnn)  <CR>  : 


which  gives  the  normal  format  (F14.6  i.e.,  14  digits--6 
decimal)  of  the  display  or  print.   If  modification  is  desired, 
an  example-like  assignment  can  be  done  as  shown  by  the 
prompt's  example  using  any  keyboard  character. 
3 .   Assigning  Information  for  the  Rows 

The  function  of  the  program  in  the  row  information 
environment  is  similar  to  that  of  column  information.   Upon 
entering  this  environment  the  following  menu-like  table. 
appears  on  the  screen: 


SELECTION  TABLE  FOR  ROW  INFORMATION 


Number  of  rows  (obligatory) 

Mnemonic  names 

Row  suppression 

Row  rejection 

Row  ranking 

Display  row  information 

Modification  of  row  info 

Data  retrieval 

Display/print  of  data  file 

Answer 
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The  process  for  the  assignment  of  each  information 
is  as  follows : 

a.   Number  of  Rows 

The  number  of  rows  is  assigned  when  the  prompt: 


Assign  number  of  rows 


appears  on  the  screen  and  can  be  up  to  204  8. 
b.   Mnemonic  Names 

For  the  rows  of  the  data  matrix,  mnemonic  names 
can  be  assigned  for  each  individual  row  or  for  a  user  deter- 
mined set  of  rows.   The  desired  kind  of  assignment  is  deter- 
mined as  soon  as  the  prompt : 


Row  by  row 

By  set  of  rows 

Answer 


appears  on  the  screen.   For  the  assignment  of  row  by  row 
names,  the  number  of  rows  has  to  be  given,  followed  by  the 
name  just  as  requested  by  the  prompts: 


Assign  row  number  (<CR>  to  RETURN) 
Assign  mnemonic 


For  assignment  of  names  by  sets  of  rows,  the  row  numbers 
determining  a  set  must  be  given  by  the  user  right  after 
the  set  of  the  following  prompts  appears  on  the  screen: 
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Common  name  set 
From  row 
To  row 
Name 


The  number  of  common  name  sets  is  automatically  given  by  the 
program.   Termination  of  assignment  is  obtained  by  hitting 
<CR>  instead  of  a  row  number. 
c.   Row  Suppression 

The  row  suppression  operation  is  a  physical 
suppression  of  rows  of  the  data  matrix.   Assignment  of  the 
rows  to  be  suppressed  can  be  done  either  by  the  row  number 
or  by  the  common  name  of  the  set.   In  this  case,  all  the 
rows  of  the  set  will  be  suppressed.   The  selection  of  mode 
follows  the  prompt: 


By  number  of  rows 
By  row  set  name 
Answer 


In  both  cases,  assignment  of  the  data  file  to  be  suppressed 
must  be  made  as  in  Section  III.B.   Assignment  of  row  numbers 
is  done  after : 


Assign  no(s)  of  rows  : 


by  printing  the  individual  row  numbers  separated  by  a  comma 
(e.g.,  4,6,7)  or  by  a  set  of  rows  determined  by  two  numbers 
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separated  by  a  colon  (e.g.,  5:10).   Both  sorts  of  assignments 
can  be  done  consecutively.   For  example,  the  suppression 
assignment  1,2,3,4,8,11,16:20  will  cause  suppression  of  the 
rows  1,2,3,4,8,11,16,17,18,19,20.   If,  after  this  assignment, 
a  display  of  row  information  is  requested  and  the  number  of 
rows  before  suppression  was  30,  information  appearing  on  the 
screen  will  be  as  follows: 


ROW    INFORMATION 
***************************** 


NUMBER  OF  ROWS 

19 
SUPPRESSIONS 


Suppression  From  Row     To  Row 

1  14 

2  8  8 

3  11  11 

4  16  20 


The  suppression  assignment  by  a  common  name  set 
of  rows  is  done  simply  by  assigning  the  name  of  the  set  after 
the  prompt : 


Suppression 
Set  name 


d.   Row  Rejection 

By  this  operation  rows  of  a  data  matrix  can  be 
assigned  which  are  to  be  excluded  from  a  calculation.   The 
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determination  of  those  columns  can  be  done  by  their  numbers, 
which  will  be  stored  in  a  sequential  file.   The  name  is 
defined  by  the  user  as  the  following  prompts  appear  on  the 
screen : 


Assign  sequential  file  for  rejected  values 

Key    (xxx)     For    File    FORxxx.DAT    number    n,     (nnn=076 

Assigned  rejected  rows  for  calculus  : 

Assign  no(s) .  of  rows  : 


e.   Row  Ranking 

The  row  ranking,  like  column  ranking,  permits  the 
assignment  of  the  order  by  which  the  rows  of  the  data  matrix 
will  be  arranged.   The  assignment  is  done  by  the  number  of 
the  rows  after  the  prompt: 


Assign  no(s) .  of  rows  : 

and  the  names  of  the  old  and  new  files  (see  Section  III.B) . 

f.  Display  Row  Information 

The  selection  of  this  table  of  the  entry  simply 
displays  the  assigned  row  information  without  any  other  user 
intervention . 

g.  Modification  of  Row  Information 

This  operation,  as  in  the  column  information 
environment,  permits  modification  of  assigned  information 
related  to  rows  of  the  data  matrix,  by  the  current  run  of  the 
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program.   In  general  the  function  of  the  program  in  this 
environment  is  similar  to  that  for  row  modification.   The 
menu  of  the  available  modifications  is  the  following: 


MODIFICATION  SELECTION  TABLE 

Number  of  rows  :1 

Mnemonics  by  row  numbers  :2 

Mnemonics  by  series  of  rows  : 3 

Suppression  :4 

Rank  of  rows  : 5 

Answer  : 


(1)   Number  of  Rows.   The  modification  of  the 
number  of  rows  is  simply  a  new  assignment  of  the  desired 
rows  following  the  prompts: 


Old  number  of  rows  : 
Assign  new  number   : 


(2)   Mnemonics  by  Rows.   This  operation  permits 
modification  of  mnemonic  names  assigned  individually  for  each 
row  of  the  data  matrix.   The  row  number  and  name  are  required 
to  be  given  after  the  prompt: 


Assign  column  number 


and  then  the  new  name  appears  after  the  prompt: 


Old  name 
Assign  new  name 
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(3)   Mnemonics  by  Series  of  Rows.   In  this  operation, 
the  program  permits  modification  of  the  set  of  rows  with  a 
common  name  or  modification  of  the  name  of  the  set.   The 
desired  modification  is  determined  with  the  assistance  of 
the  prompt : 


Series  modification 
Name  modification 
Answer 


If  modification  of  the  series  of  rows  with  a  common  name  is 
desired,  the  number  of  the  series  (set)  must  be  determined 
after  the  prompt: 


Assign  series  number  : 


and  the  old  series  is  displayed  on  the  screen  to  facilitate 
the  new  assignment: 


Old  series 
From  row 
To  row 


while  at  the  same  time  the  prompt 


Assign  new  series 
From  row 
To  row 
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permits  assignment  of  the  new  specification  of  the  series. 

If  modification  of  the  common  name  of  the  set  is  desired,  the 

prompt : 


Assign  series  number 


requests  the  number  of  the  set  to  be  modified.  Then  the  old 
mnemonic  appears  on  the  screen  together  with  the  request  for 
new  mnemonic  name  assignment: 


Old  mnemonic 
Assign  new  mnemonic 


(4)   Suppression .   As  mentioned  in  Section  III.E.3.C, 
the  suppressions  automatically  have  sequence  numbers 
attached  to  them.   Modification  of  the  suppressions  is  done 
by  first  assigning  the  suppression  sequence  number  requested 
by  the  prompt: 


Assign  suppression  number  : 

Modification  of  the  suppressed  rows  is  facilitated  by  the 
display  of  the  old  suppression  specification  requesting  the 
new  assignment: 
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Old  suppression 

From  row 

To  row 

Assign  new  suppression 

From  row 

To  row 


(5)   Rank  of  Rows.   Modification  of  row  ranking 


is  executed  by  the  following  prompt 


Old  ranking 

Assign  no(s)  of  rows 


h.   Data  Retrieval 

This  is  simply  another  place  in  the  program  where 
the  retrieval  of  data  can  be  obtained  in  exactly  the  same 
way  as  in  Section  III.E.2.J. 

i.   Display/Print  of  Data  File 

This  is  an  alternative  position  for  display  or 
print  of  the  data  file,  executed  the  same  way  as  in  Section 
III.E.2 .k. 

2 .   Displaying  an  Existing  Header 

This  is  the  second  mode  of  operation  of  the  program. 
It  simply  displays  either  the  column  or  row  information  of  a 
header  created  by  a  previous  run  of  the  program.   As  has 
been  mentioned,  information  of  a  created  header  is  stored 
in  a  sequential  file  in  secondary  storage.   This  file  is 
automatically  opened  by  the  program.   Data  are  read  and 
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displayed  on  the  screen  by  the  simple  assignment  of  the  name 
of  the  header's  file  requested  by  the  prompt: 


Name  of  header's  file  : 


The  next  required  assignment  is  the  determination  of 
column  or  row  information  display: 


Column  information 
Row  information 

Answer 


Exit  of  the  mode  is  obtained  by  <CR> . 

3 .  Modifying  an  Existing  Header 

In  this  mode,  the  modification  of  a  header  created 
by  a  previous  run  of  the  program  can  be  obtained  by  simply 
assigning  the  name  of  the  header's  file. 

4 .  Merging 

With  this  mode  of  operation,  a  merging  of  two  data 
matrices  and  combination  of  their  corresponding  headers  is 
obtained.   This  operation  can  be  executed  in  the  horizontal 
(column  merging)  or  vertical  (row  merging)  sense;  in  other 
words  the  matrices  can  be  merged  side  by  side  or  one  over  the 
other.   Horizontal  merging  is  only  permitted  by  the  program 
if  the  two  matrices  have  the  same  number  of  rows  while  vertical 
merging  is  permitted  if  they  have  the  same  number  of  columns. 
The  resultant  headers  in  such  an  operation  are  as  follows: 
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Row  merging. 

Column  names:   If  the  same  column  has  a  mnemonic 

name  in  both  headers,  then  the  name  of 
the  first  header  (upper  matrix)  is  kept 
as  the  column  name.   Otherwise  the 
unique  name  in  either  header  is  kept 
as  the  column  name. 
Tracing  extrema :   If  tracing  extrema  are  assigned  for 

the  same  column  in  both  headers,  then 
the  minimum  of  the  two  minima  and  the 
maximum  of  the  two  maxima  of  the 
columns  are  kept  as  tracing  extrema 
for  the  column.   Otherwise  the  unique 
minimum  and  maximum  values  are  kept  as 
tracing  extrema  for  the  column. 
Row  names:   The  names  of  rows  of  the  two  headers 

whenever  they  exist. 
Column  merging. 

The  naming  of  the  rows  of  the  combined  header  is  done 
in  the  same  way  as  the  naming  of  columns.   Since  the  first 
one  of  the  two  merged  data  matrices  is  adjusted  to  the  left 
of  the  created  common  matrix,  the  naming  of  the  sets  of  rows 
of  this  file  is  kept  as  the  common  name  for  the  corresponding 
rows  of  the  new  matrix. 

The  operation  of  merging  is  executed  without  any 
extra  intervention  of  the  user,  simply  by  assignment  of  the 
file  names  of  the  two  headers  to  be  combined: 


Name  of  first  Header's  file 
Name  of  second  Header's  file 
Name  of  new  Header's  file 


and  the  sort  of  desired  merging: 


Row  merging     : 1 
Column  merging  :2 


The  names  of  the  files  on  which  the  two  merged  matrices  are 
stored  and  the  one  on  which  the  new  one  will  be  stored,  uses 
the  process  described  in  Section  III.B. 
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IV.   CONCLUSION  AND  PERSPECTIVES 

The  interactive-conversational  character  makes  the  system 
easily  usable  and  independent  of  knowledge  requirements. 
The  language  used  for  implementation  (FORTRAN  77)  makes  it 
transportable.   The  separation  of  the  data  manipulation  process 
from  the  calculations  also  makes  it  highly  expandable.   Since 
the  developed  system  composes  only  the  module  for  manipulation 
of  the  data,  development  of  the  remaining  modules  constitute 
the  perspectives  of  the  concept  in  order  for  it  to  be  complete. 
The  cycle  of  data  analysis  is  realized  if  the  following  process 
is  completed: 

(I  DAMAN) 


DATA  STORAGE  -  DATA  MANIPULATION  -  DATA  TREATMENT' 
<  < 


Data  can  be  obtained  and  stored  automatically  by  a 
previous  program  or  by  the  keyboard  under  control  of  a 
specific  program--the  Interactive  DAta  LOaDer,  IDALOD, 
which  is  under  development  by  Dr.  Daniel  Guinier. 
Data  treatment  (statistical  or  mathematical)  can  be  done 
by  modification  of  modules  of  existing  packages  by 
addition  of  the  two  subroutines  READER,  in  relation  with 
the  "header  file",  and  REJECT,  in  relation  with  a 
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"logical  suppression  file".   This  file  has  been  previously 
created  by  IDAMAN.   Application  programs  involve: 

one  column  (e.g.,  comparisons  of  means  of  sets  of 
observations  stored  in  one  or  several  columns) , 
two  columns  (e.g.,  graphs  including  observed  and/or 
data  fit  with  a  given  model) , 

several  columns  (e.g.,  multivariate  statistical 
analysis  (discriminant,  principal  components,  cluster, 
...  analysis),  can  be  easily  developed.   There  is  no 
limitation  to  the  expandability  because  these  tasks 
are  not  included  in  the  previous  tasks  of  loading  and 
management . 


91 


c 
c 
c 
c 
c 

£***  * 

c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 


APPENDIX  A 
FORTRAN  77  Source  Code  of  Interactive  Data  Manager 

********************************************************* 

Interactive    DATa    MANager 

I    DAMAN 
FUNCTION    : 


This  system  provides  the  means  for  an  interactive  and 
self  explanatory  manipulation  of  large  collections  of 
data  stored  in  direct-access  files  in  secondary  memory. 
The  way  the  system  can  manipulate  the  data  is  such  that 
facilitates  the  future  statistical  analysis  of  them.  The 
system  can  execute  the  following  manipulations 
( f unct  ions ) 


a. 

b. 
c  . 
d. 
e . 
f  . 


g 

h 


Sort  the  data  matrix. 

Multi-sort  the  data  matrix. 

Search  the  data  matrix  for  a  value. 

Rearrangement  the  columns  or  rows  of 

Transformation  of  a  column  values. 

Randomization   of   the   values   of 

matrix . 

Logical  suppression  of  data. 

Display  of  the  assigned  HEADER. 

Display  of  the  data  matrix. 


the  data  matrix, 
the   entire   data 


By  D.GUINIER  and  N.TOTOS  (1984) 

Naval  Postgraduate  School,  Depatrment  of  Computer  Science 

Monterey,  California  93940 


VARIABLES 


NCOL 
NROW 
COLMNE 
NKEY 

MNE 

ROWMNE1 
ROWMNE2 
NRANK 


The  number  of  columns. 

The  number  of  rows. 

Array  storing  the  column  mnemonic  names. 

Array  storing  the   numbers   of  columns  which 

will  be  used  as  sorting  guides. 

Array   storing   the   names   of  columns  which 

will   be  used  as  sorting  guides. 

Array  storing  the  row  mnemonic  names. 

Array  storing  the  mnemonics  of  sets  of  rows. 

Array  storing  the   numbers   of   columns  that 

assign  the  ranking  of  columns. 
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c 

MRANK 

c 

c 

A, 3 

c 

c 

c 

SUP1,SUP2 

c 

c 

c 

RMIN,RMAX 

c 

c 

c 

NCO 

c 

c 

NRO 

c 

c 

NTR 

c 

c 

NCIN 

c 

NRIN 

c 

NT  IN 

c 

SN 

c 

FLAG1 

c 

c 

c 

FLAG2 

c 

FNAiME 

c 

c 

c 

H1FNAME 

c 

c 

H2FNAME 

c 

NC 

c 

NR 

c 

NT 

c 

c 

IJ 

c 

NN 

c 

c 

NM 

c 

c 

NNU 

c 

KMN 

c 

LEC 

c 

IMP 

c 

c 

LOGN 

c 

c 

NOROW 

c 

c 

.  NBROW 

c 

c 

£************** 

and   maximum 
f  the  data  is 


columns  for  which  have  beer. 


which   have   been 


Array  storing   tne   names   of   columns   that 

assign  the  ranking  of  columns. 

Arrays  storing  the  mumber  of   row   on   which 

starts   a   set   of   common  name  rows  and  the 

corresponding  on  which  ends  the  set. 

Arrays   storing   the   number  of  row  on  which 

starts     suppression    of   rows    and    the 

corresponding  on  which  ends  the  suppression. 

Arrays   storing   the   minimum 

values   between  which  tracing 

going   to  take  place 

The   numbers   o 

assigned  names. 

The   numbers  of  rows   for 

assigned  names. 

The  column  numbers  for  which  tracing  extre 

have  been  assigned. 

The  invert  relative  addresses  of  COLMNE. 

The  invert  relative  addresses  of  RCWMNE1. 

The  invert  relative  addresses  of  RMIN,RMAX. 

The  number  of  assigned  suppressions. 

Integer  array  of  six   elements   used  as  flag 

to  indicate   the   existence   or   not   of  the 

several  informations  regarding  the  columns. 

The  corresponding  flag  for  rows. 

The  name  of  the  sequential  file   assigned  by 

the  user   for   on   which   the  headers' s  data 

will   be  stored. 

The  name   of   the   first  header's  file  which 

will  be  merged. 

The  name  of  the  second  file  for  merging. 

The  number  of  assigned  column  mnemonic  names 

The  number  of  assigned  row  mnemonic  names. 

The   number  of   columns   for   which   tracing 

extrema  have  been  assigned. 

The  number  of  assigned  tracing  extrema  sets. 

The   number  of  repeated   sortings   according 

column  numbers. 

The   number   of  repeated  sortings   according 

column  mnemonic  names. 

The  number  of  columns  used  for  ranking. 

The  number  of  column  names  used  for  ranking. 

The  logical  unit  for  writing  on  the 

The   logical   unit   for   reading 

terminal . 

The  logical  chanel  for  the  file  on  which  the 

header, s  data  will  be  stored. 

Array   the   numbers   of   rows  used  as  guides 

for  the  ranking  of  the  rows. 

The   number   of   row   numbers 

ranking 


i 


terminal 
from    the 


used   for  row 


*********************************************************** 
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c 

C      DECLARATIONS 
C 


IMPLICIT  INTEGER*2  (I-N) 

INTEGER* 2  SN,FLAG1(6) , FLAG 2 ( 4 ) , NKEY (128) , NRANK ( 128)  , 

1  B  (  1 2  8  )  , SUP 1(12  8), SUP  2(128), NCO (128), 

2  NRO (128), NTR ( 1 2  8 )  , NT  I N ( 1 2  8 )  , NR I N ( 2  0  4  8 )  , 

3  NOROW( 2048 ) ,A( 128) ,NCIN( 128) 
REAL*4  RMIN(128) , RMAX ( 128) 

CHARACTER*24  FNAME , H1FNAME , H2FNAME ,  IND,COLMNE(  123  )  , 

1  MNE (12  8) , MRANK (128) , ROWMNE 1(2048) , 

2  ROWMNE2(128) 
LOGICAL*l  STAT,STAT1,STAT2 
DATA  LEC, IMP,LOGN/5, 6,0/ 

IDUM=1 

DO  WHILE  ( IDUM.EQ. 1) 
IDUM=0 

WRITE( IMP, 100) 
READ(LEC,2  00)  IND 
IF  ( IND.EQ. ' 1 ' )  THEN 

CALL  CREATE ( LEC , IMP , LOGN , FLAG1 , FLAG2 , NCOL , NROW , 

1  COLMNE , NC , NCO , NCI N , ROWMNE 1 , NR , NRO , NR I N , 

2  ROWMNE  2 , RM I N , RMAX , NT , NTR , NT  I N , NKEY , MNE , NN , 

3  NM, IJ,A,B,NRANK,MRANK,NNU,KMN,SUP1 , SUP2 , SN, 

4  NOROW,NBROW) 
IDUM=1 

ELSE  IF  (IND.EQ.' 2')  THEN 

CALL  DISPLA( LEC, IMP , LOGN , FLAG1 , FLAG2 , NCOL , NROW , 

1  COLMNE , NC , NCO , NC I N , ROWMNE 1 , NR , NRO , NR I N , 

2  ROWMNE2 , RMIN , RMAX , NT , NTR , NT  IN , NKEY , MNE , NN , 

3  NM, IJ,A,B,NRANK,MRANK,NNU,KMN,SUP1 ,SUP2 , SN, 

4  NOROW,NBROW) 
IDUM=1 

ELSE  IF  (IND.EQ. '3')  THEN 

CALL  MODI  FY (LEC,  IMP , LOGN , FLAG1 , FLAG2 , NCOL, NROW, 

1  COLMNE , NC , NCO , NC I N , ROWMNE 1 , NR , NRO , NR I N , 

2  ROWMNE2 , RMIN , RMAX , NT , NTR , NT  IN , NKEY , MNE , NN , 

3  NM , I J , A , B , NRANK , MRANK , NNU , KMN , SUP 1 , SUP  2 , SN , 

4  NOROW,NBROW) 
IDUM=1 

ELSE  IF  (IND.EQ. '4')  THEN 

CALL  MERGE ( LEC , IMP , LOGN , FLAG1 , FLAG2 , NCOL , NROW , 

1  COLMNE , NC , NCO , NC I N , ROWMNE 1 , NR , NRO , NR I N , 

2  ROWMNE  2 , RM I N , RMAX , NT , NTR , NT  I N , NKEY , MNE , NN , 

3  NM, I J, A, B, NRANK, MRANK, NNU, KMN, SUP  1 ,SUP2 , SN, 

4  NOROW,NBROW) 
IDUM=1 

ELSE  IF  (IND.EQ.'   ")  THEN 

IDUM=0 
ELSE 

WRITE( IMP, 300) 

IDUM=1 
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c 
c 
c 

100 


200 
300 


END  I? 
END  DO 

FORMATS 


FORMAT(/////13X, 'AVAILA3LS  MODES' /13X, 

1 

2 

3 

4 

5 

6 

FORMAT 


'$' 
A2  4) 


' */ 

4X, 'Creation  of  new  header 

4X, 'Display  of  existing  header 

4X, ' Modi f icat ion  of  existing  header 

Merging  of  two  existing  headers 

Answer 


4X, 
3X, 


IV 
2'/ 
3'/ 
4'/ 
'  ) 


FORMAT (/3X, ' INVALID  CHARACTER! ! ' ) 


END 


CREATE (LEC, IMP , LOGN , FLAG1 , FLAG2 ,NCOL,NROW, 
COLMNE , NC , NCO , NC I N , ROWMNE1 , NR , NRO , NRI N , 
RCWMNE 2 , RMI N , RMAX , NT , NTR , NT  I N , NKEY , MNE , NN , 
NM ,  IJ , A , B , NRANK , MRANK , NNU , KMN , SUP  1 , SUP  2 , SN , 
NOROW,NBRCW) 

ine  is  used  for  the  creation  of  a  new  header. 


SUBROUTINE 

1 

2 

3 

4 

£*************** 

c 

c 

This  subrout 

c 

c 

ARGUMENTS 

c 

c 

c 

LEC 

c 

c 

IMP 

c 

c 

LOGN 

c 

c 

FLAG1 

c 

c 

c 

FLAG2 

c 

NCOL 

c 

NROW 

c 

COLMNE 

c 

NC 

c 

NCO 

c 

c 

NCIN 

c 

ROWMNE1 

c 

NR 

c 

NRO 

c 

c 

NRIN 

The  logica 
terminal . 
The  logica 
terminal . 
The  logica 
header, s  d 
Integer  ar 
to  indicat 
several  in 
The  corres 
The  number 
The  number 
Array  stor 
The  number 
The  numbe 
assigned  n 
The  invert 
Array  stor 
The  number 
The  number 
been  assig 
The  invert 


1  unit  number  for   writing  on   the 
1  unit  number  for  reading  from  the 


1  unit  for  the 
at  a  will  be  st 
ray  of  six  el 
e  the  existe 
formations  reg 
ponding  flag  f 

of  columns. 

of  rows. 
ing  the  column 

of  assigned  c 
rs  of  columns 
ames  . 

relative  addr 
ing  the  row  mn 

of  assigned  r 
s  of  rows  for 
ned. 

relative  addr 


file  on   which  the 
ored . 

ements   used  as  flag 
nee   or   not   of  the 
arding  the  columns. 
or  rows. 


mnemonic  names, 
olumn  mnemonic  names 
for  which  have   been 

esses  of  COLMNE. 
emonic  names, 
ow  mnemonic  names, 
which   names   have 

esses  of  ROWMNE . 
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c 

R0WMNE2 

c 

RM I N ,  RM  AX 

c 

c 

c 

NT 

c 

c 

NTR 

c 

c 

NT  IN 

c 

NKEY 

c 

c 

MNE 

c 

c 

NN 

c 

c 

NM 

c 

c 

IJ 

c 

A,B 

c 

c 

c 

NRANK 

c 

c 

MRANK 

c 

c 

NNU 

c 

KMN 

c 

STJP1,SUP2 

c 

c 

c 

SN 

c 

NO  ROW 

c 

c 

NBROW 

c 

c 

(2************** 

which   trac 


trac  ing 

g 


Array  storing  the   mnemonics  of  sets  of  rows 

Arrays   storing   the   minimum   and    maximum 

values  between   which  tracing  of  the  data  is 

going  to  take  place. 

The   number  of   columns   for   which 

extrema  have  been  assigned. 

The   column    numbers    for 

extrema  have  been  assigned. 

The  invert  relative  addresses  of  RMIN,RMAX. 

Array  storing   the  numbers   of  columns  which 

will  be  used  as  sorting  guides. 

Array  storing  the   names   of   columns   which 

will  be  used  as  sorting  guides. 

The  number  of   repeated   sortings   according 

column  numbers. 

The   number  of  repeated   sortings   according 

column  mnemonic  names. 

The  number  of  assigned   tracing  extrema  sets 

Arrays   storing  the   mumber  of   row  on  which 

starts   a   set  of  common   name  rows   and  the 

corresponding  on  which  ends  the  set. 

Array  storing  the   numbers   of 

assign  the  ranking  of  data 

Array   storing   the   names   of 

assign  the  ranking  of  data 

The  number  of  columns  used  for  ranking. 

The  number  of  column   names  used  for  ranking 

Arrays  storing  the   number   of   row  on  which 

starts   suppression   of    rows     and     the 

corresponding  on   which  ends  the  suppression 

The  number  of  assigned  suppressions. 

Array   the   numbers   of   rows  used  as  guides 

for  the  ranking  of  the  rows. 

The  number   of   row   numbers    used   for  row 

ranking 

********************************************* 


columns  that 
columns  that 


C 
C 

c 


IMPLICIT  INTEGER*2  (I-N) 

INTEGER* 2  SN,FLAG1(6) , FLAG2 ( 4 ) ,NKEY( 128) , NRANK ( 128) , 

1  B(128) , SUPK 128) ,SUP2( 128) , NCO ( 128 ) , NCIN( 1 2  8 ) , 

2  NRO (12  8), NTR ( 1 2  8 )  , NT  I N ( 1 2  8 )  , NR I N ( 2  0  4  8 )  , 

3  NOROW(2048) ,A( 128) 
REAL*4  RMIN( 128) , RMAX ( 128) 

CHARACTER*  2  4  FNAME , COLMNE (12  8)  , MNE (128), MRANK (128)  , 

1  ROWMNEK  2048 )  ,ROWMNE2 ( 128)  , IND , H1FNAME , H2FNAME 

LOGICAL*l  STAT,STAT1,STAT2 

Request  a  name  for   the  file  on  which  the  data   of  the 
header  will  be  stored. 


WRITE( IMP, 200) 
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READ(LEC,100)  FNAME 

C       Examine  if  a  file  whith  this  name  already  exists. 
INQUIRE(FILE=FNAME,EXIST=STAT) 

C       If  not,  open  a  new  sequential  file. 

IF  ( STAT. EQ. . FALSE. )  THEN 

OPEN  (  UN  I  T  =  LOGN  ,  F I  LE  =  FNAME  ,  ST  ATUS  =  '  NEW  '  ') 

C  Call  the  subroutine  which  will   request 

C  or  row  informations. 

CALL  CRINFO ( LEC , IMP , FLAG1 , FLAG2 , NCOL , NROW , COLMNE , 

1  NC , NCO , NC I N , ROWMNE 1 , NR , NRO , NR I N , ROWMNE 2 , 

2  RM I N , RMAX , NT , NTR , NT  I N , NKE Y , MNE , NN , NM , IJ , 

3  A , B , NRANK , MRANK , NNU , KMN , SUP 1 , SUP  2 , SN , 

4  N0R0W,N3R0W) 

C  Record  the  assigned  data   in   the  opened   file   for 

C        future  reference. 

CALL  WRITER  ( LOGN, FLAG1 , FLAG2 , NCOL , NROW, KMN , NNU , NN , 

1  NM , I J , A , 3 , COLMNE , NC , NCO , NC I N , RMIN , RMAX , 

2  NT , NTR , NT  I N , NKEY , MNE , NRANK , MRANK , 

3  ROWMNE 1,NR, NRO, NR IN, ROWMNE 2 ,SU?1 ,SU?2 , 

4  SN,NOROW,NBRCW) 

C       If  the  file  already  exists,  respond  with  a  message. 

ELSE 

WRITE( IMP, 300) 

IDUM=1 
END  IF 

C      FORMATS 
C      

c 

100    FORMAT(A24) 

200    FORMAT (///'$', 3X, 'Name  of  header's  file  :') 

300    FORMAT(///4X, 'THE  FILE  ALREADY  EXIST!!') 

RETURN 

END 

£******  ******************************************************  * 

SUBROUTINE  DISPLA(LEC, IMP , LOGN , FLAG 1 , FLAG2 , NCOL, NROW, 

1  COLMNE , NC , NCO , NC I N , ROWMNE 1 , NR , NRO , 

2  NRI N , ROWMNE2 , RM I N , RMAX , NT , NTR , NT  I N , 

3  NKEY , MNE , NN , NM , I J , A , B , NRANK , MRANK , NNU , 

4  KMN, SUP  1, SUP 2 , SN , NOROW , NBROW ) 

£*****************x******************************************* 

C 

C   This  subroutine  is  used  to  display  the  data  of  a  preveusly 
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c 

defined  header 

c 

c 
c 

ARGUMENTS 

c 

c 

EEC         : 

c 

c 

IMP        : 

c 

c 

LOGN       : 

c 

c 

FLAG1      : 

c 

c 

c 

FLAG2      : 

c 

NCOL       : 

c 

NROW       : 

c 

COLMNE     : 

c 

NC         : 

c 

NCO        : 

c 

c 

NCIN       : 

c 

ROWMNE1    : 

c 

NR         : 

c 

NRO        : 

c 

c 
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c 

NNU 

c 

KMN 

c 

SUP1,SUP2 

c 

c 

c 

SN 

c 

NOROW 

c 

c 

NBROW 

c 

c 

The  number  of  columns  used  for  ranking. 

The  number  of  column   names  used  for  ranking 

Arrays  storing  the   number   of   row  on  which 

starts   suppression   of    rows     and     the 

corresponding  on   which  ends  the  suppression 

The  number  of  assigned  suppressions. 

Array   the   numbers   of   rows  used  as  guides 

for  the  ranking  of  the  rows. 

The  number   of   row   numbers    used   for  row 

rank  ing 

£********************************^ 

C 

IMPLICIT  INTEGER*2  (I-N) 

INTEGER* 2  SN,FLAG1(6) ,FLAG2(4) , NKEY ( 128) , NRANK ( 123) , 

1  B(128) ,SUP1(128) ,SUP2(128) ,NCO(128) ,NCIN(128) , 

2  NROQ28)  ,NTR(128)  , NTIN( 128 ), NRIN( 20  48 ) , 
NOROW (2048) ,A( 128) 

REAL*4  RMIN( 128) ,RMAX(128) 

CHARACTER* 2 4  FNAME , COLMNE ( 12  8 ) ,MNE(128) , MRANK ( 128) , 

1  ROWMNEK2  04  8)  ,  ROWMNE2  (  128  )  ,  IND,H1FNAME, 

H2FNAME 
LOGICAL*!  STAT,STAT1,STAT2 


WRITE ( IMP, 200) 

Request  the  name  of  the  file. 

READ(LEC, 10  0 )  FNAME 

I NQU I  RE ( F I LE  =  FNAME , EX  I ST=STAT ) 

If  the  file  exists  open  it. 

I F  ( STAT . EQ . . TRUE . )  THEN 

OPEN ( UN I T=LOGN,F I LE= FNAME, STATUS =* OLD* ) 
REWIND  LOGN 

Call  the  subroutine  READER  to  read  the  data  of  the  file 

CALL  READER ( LOGN , FLAG1 , FLAG2 , NCOL , NROW , KMN , NNU , NN , MM , 

1  I J , A , B , COLMNE , NC , NCO , NC I N , RM I N , RMAX , NT , 

2  NTR , NT  I N , NKEY , MNE , NRANK , MRANK , ROWMNE 1 , NR , 

3  NRO,NRIN,ROWMNE2,SUPl,SUP2  ,  SN  ,  NrOROW  ,  NBROW  ) 
IDUM=1 


C 


Loop  for  succesive  display  capability 

DO  WHILE( IDUM.EQ. 1) 
IDUM=0 

Request  for  column  or  row  display. 

WRITE( IMP, 3  00) 
READ(LEC, 100)  IND 
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IF  ( IND.SQ. ' I' )  THEN 
C  If  column  display  is  requested; 

CALL  CD  I SP ( LEC ,  IMP , FLAG1 , NCOL , COLMNE , NC , NCO , 

1  NC I N , RMI N , RMAX , NT , NTR , NT  I N , NKEY , MNE , 

2  NN  ,  NM  ,  NRANK  ,  MRANK  ,  NNU  ,  KMN  ) 
IDUM=1 

ELSE  IF  (IND.EQ.'2')  THEN 

C  If  row  display  is  requested; 

CALL  RDISP ( LEC , IMP , FLAG2 , NROW, ROWMNE1 , NR , NRG , 

1  NRIN,ROWMNE2  ,  IJ  ,  A  ,  B  ,  SUPl  ,  SUP2  ,SN, 

2  NOROW,NBROW) 
IDUM=1 

C  If  <CR>  stop  the  loop. 

ELSE  IF  (IND.EQ.'   ')  THEN 
IDUM=0 

C  If  invalid  character  is  hit  give  an  error  message. 

ELSE 

WRITE( IMP, 400) 
IDUM=1 

END  IF 
END  DO 
END  IF 

C      FORMATS 
C      

c 

100    FORMAT (A2 4) 

200    FORMAT  (///'$'  ,3X,  'Name  of  header'  's  file  :'.) 

300    FORMAT(///4X,     'Column  informations    :1' 

1  /4X,     'Row  informations       :2' 

2  /' $' ,3X, 'Answer  : ' ) 
400    FORMAT (/3X, ' INVALID  CHARACTER!!') 

RETURN 
END 


rj***********************************^ 

SUBROUT I NE  MOD  I  FY ( LEC , IMP , LOGN , FLAG1 , FLAG2 , NCOL , NROW , 

1  COLMNE, NC,NCO,NC I N,ROWMNEl , NR , NRO , NRI N , 

2  ROWMNE 2 , RM I N , RMAX , NT , NTR , NT  I N , NKEY , MNE , 

3  NN , NM , I J , A , B , NRANK , MRANK , NNU , KMN , SUP 1 , 

4  SUP2 ,SN,NOROW,NBROW) 

C 

C   This  subroutine  is   used   for   modification  of  an  existing 
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Array  storing  the  column  mnemonic  names. 

The  number  of  assigned  column  mnemonic  names 

The   numbers  of  columns  for  which  have   been 
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The  invert  relative  addresses  of  COLMNE. 
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C  KMN        :  The  number  of  column   names  used  for  ranking 

C  SUP1,SUP2  :  Arrays  storing  the   number   of   row  on  which 

C  starts   suppression   of    rows     and     the 

C  corresponding  on   which  ends  the  suppression 

C  SN         :  The  number  of  assigned  suppressions. 

C  NOROW      :  Array   the   numbers   of   rows  used  as  guides 

C  for  the  ranking  of  the  rows. 

C  NBROW      :  The  number   of   row   numbers    used   for  row 

C  ranking 

C 

£******x**************x*****************^ 

IMPLICIT  INTEGER*2  (I-N) 

INTEGER* 2  SN,FLAG1(6) , FLAG2 ( 4 ) , NKEY ( 128) , NRANK ( 128) , 

1  B(128) ,SUP1( 128) ,SUP2( 128) ,  NCOQ28) ,NCIN{128) , 

2  NRO (128), NTR (128),NTIN(128),NRIN(2048), 

3  NOROW ( 2  0  48 ) ,A( 128) 
REAL*4  RMIN( 128) ,RMAX(128) 

CHARACTER*  2  4  FNAME , COLMNE (12  8), MNE (128), MRANK (123), 

1  ROWMNEK2048)  ,  ROWMNE2(  128)  ,  IND,H1FNAME, 

2  H2FNAME 
LOGICAL*l  STAT,STAT1,STAT2 

C       Request  the  name   of   the   file   where  the  data  of  the 
C       existing  header  are  stored. 

WRITE( IMP, 200) 

READ(LEC, 100)  FNAME 

INQUIRE (FILE=FNAME,EXIST=STAT) 

C       If  the  file  exists  open  it. 

I F  ( STAT . EQ . . TRUE . )  THEN 

OPEN(UNIT=LOGN,FILE=FNAME,STATUS= 'OLD' ) 
REWIND  LOGN 

C  Read  the  data  of  the  existing  header. 

CALL  READER ( LOGN, FLAG 1 , FLAG2 , NCOL , NROW , KMN , NNU , NN , NM , 

1  I J , A , B , COLMNE , NC , NCO , NC I N , RM I N , RMAX , NT , NTR , 

2  NT I N , NKEY , MNE , NRANK , MRANK , ROWMNE 1 , NR , NRO , 

3  NRIN,ROWMNE2 ,SUP1,SUP2 , SN , NOROW , NBROW ) 

C  Close  the  old  file. 

CLOSE(UNIT=LOGN) 

C  Open  a  new  file  with  the  same  name. 

OPEN(UNIT=LOGN, FILE=FNAME, STATUS= ' NEW' ) 
IDUM=1 

C  Loop  for  succesive  modification  capability. 
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DO  WHILE ( IDUM.EQ. 1 ) 
IDUM=0 

C  Request  for  column  or  row  modi  f  icat  ior. . 

WRITE( IMP, 400) 
READ(LEC, 100)  IND 

C  If  column  modification  is  desired; 

IF  ( IND.EQ.  ' 1  *  )  THEN 

C  Call  COLMOD  for  column  modification. 

CALL  COLMOD ( LEC , IMP , FLAG1 , NCOL , NRCW , COLMNS , NC , 

1  NCO , NC I N , RM I N , RMAX , NT , NTR , NT  I N , 

2  NKEY , MNE , NN , NM , NRANK , MRANK , NNU , KMN ) 

C  Call   WRITER  to   record   the  modified  header's 

C  data. 

CALL  WRITER ( LOGN , FLAG1 , FLAG 2 , NCOL , NRCW , KMN , 

1  NNU , NN , NM , IJ , A , B , COLMNE , NC , NCO , 

2  NC I N , RM I N , RMAX , NT , NTR , NT  I N , NKEY , 

3  MNE , NRANK , MRANK , ROWMNE 1 , NR , NRO , 

4  NRIN,R0WMNE2,SUP1,SUP2 , SN,NOROW, 

5  NBROW) 
IDUM=1 

C  If  row  modification  is  desired; 

ELSE  IF  (IND.EQ. '2')  THEN 

C  Call  ROWMOD  for  row  modification. 

CALL  ROWMOD (LEC, IMP , FLAG2 , NCOL , NROW , ROWMNE 1 , NR , 

1  NRO,NRIN,ROWMxNE2  ,  IJ,  A,3,SUP1  ,SU?2  , 

2  SN,NOROW, NBROW) 

C  Call   WRITER   to  record   the   modified  header's 

C  data. 

CALL  WRITER ( LOGN , FLAG1 , FLAG2 , NCOL , NRCW , KMN , NNU , 

1  NN , NM , I J , A , B , COLMNE , NC , NCO , NC I N , 

2  RMI N , RMAX , NT , NTR , NT  I N , NKEY , NME , 

3  NRANK , MRANK , ROWMNE 1 , NR , NRO , NR I N , 

4  ROWMNE2,SUPl ,SUP2 , SN , NORCW , NBROW ) 
IDUM=1 

C  If  <CR>  stop  the  loop. 

ELSE  IF  ( IND.EQ. '   ' )  THEN 
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IDUM=0 

C  If  invalid  character  is  hit  give  an  error  message. 

ELSE 

WRITE( IMP, 500) 
IDUM=1 
END  IF 
END  DO 

C        If  the  file  does  not  exist  give  an  error  message. 

ELSE 

WRITE( IMP, 300) 
I DUM= 1 

END  IF 

C      FORMATS 
C      

c 

100    FORMAT(A24) 

200    FORMAT (///*$*, 3X, 'Name  of  header'  *s  file  :') 

300    FORMAT (///4X, 'THE  FILE  DOES  NOT  EXIST!!') 

400    FORMAT (///4X, 'Column  :l'/4X,'Row     :2'/'$',3X, 

1  ' Answer  : ' ) 

500    FORMAT(/3X, ' INVALID  CHARACTER!!') 

RETURN 

END 


SUBROUTINE  MERGE (LEC, IMP , LOGN , FLAG1 , FLAG2 ,NCOL,NROW, 

1  COLMNE , NC , NCO , NC I N , ROWMNE 1 , NR , NRO , NR I N , 

2  ROWMNE2 , RM I N , RMAX , NT , NTR , NT  I N , NKEY , MNE , 

3  NN , NM , I J , A , B , NRANK , MRANK , NNU , KMN , SUP1 , 

4  SUP2,SN,NOROW,NBROW) 

Q* ***********************************************************  * 

c 

C  This   subroutine  is  used  to  merge   two  existing  headers. 

C  The   merging   can   be   executed   in    the    row-row    or 

C  column-column  sense. 

C 

C  ARGUMENTS 

C  

C  ARGUMENTS 

C  

c 

C  LEC        :  The  logical  unit  number  for   writing  on   the 

C  terminal. 

C  IMP        :  The  logical  unit  number  for  reading  from  the 

C  terminal . 

C  LOGN       :  The  logical  unit  for  the   file  on   which  the 

C  header, s  data  will  be  stored. 
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maximum 
data  is 

tracing 
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Integer  array  of  six   elements   used  as  flag 

to  indicate   the   existence   or   not   of  -re 

several  informations  regarding  the  columns. 

The  corresponding  flag  for  rows. 

The  number  of  columns. 

The  number  of  rows. 

Array  storing  the  column  mnemonic  names. 

The  number  of  assigned  column  mnemonic  names 

The   numbers  of  columns  for  which  have   been 

assigned  names. 

The  invert  relative  addresses  of  COLMNE. 

Array  storing  the  row  mnemonic  names. 

The  number  of  assigned  row  mnemonic  names. 

The  numbers  of  rows   for   which   names   have 

been  assigned. 

The  invert  relative  addresses  of  ROWMNE. 

Array  storing  the   mnemonics  of  sets  of  rows 

Arrays   storing   the   minimum   and 

values  between   which  tracing  of  the 

going  to  take  place. 

The   number  of   columns   for   which 

extrema  have  been  assigned. 

The   column    numbers    for    which 

extrema  have  been  assigned. 

The  invert  relative  addresses  of  RMIN,RMAX. 

Array  storing   the  numbers   of  columns  which 

will  be  used  as  sorting  guides. 

Array  storing  the   names   of   columns   which 

will  be  used  as  sorting  guides. 

The  number  of   repeated   sortings 

column  numbers. 

The   number  of  repeated 

column  mnemonic  names. 

The  number  of  assigned   tracing  extrema  sets 

Arrays   storing  the   mumber  of   row  on  which 

starts   a   set  of  common   name  rows   and  the 

corresponding  on  which  ends  the  sen. 

Array  storing  the   numbers 

assign  the  ranking  of  data 

Array   storing   the   names 

assign  the  ranking  of  data 

The  number  of  columns  used  for  ranking. 

The  number  of  column   names  used  for  ranking 

Arrays  storing  the   number   of   row  on  which 

starts   suppression   of    rows     and     the 

corresponding  on   which  ends  the  suppression 

The  number  of  assigned  suppressions. 

Array   the   numbers   of   rows  used  as  guides 

for  the  ranking  of  the  rows. 

The.  number   of   row   numbers    used   for  row 

ranking 


*********************************************************** 


c 

FLAG1 

c 

c 

c 

FLAG  2 

c 

NCOL 

c 

NROW 

c 

COLMNE 

c 

NC 

c 

NCO 

c 

c 

NCIN 

c 
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IMPLICIT  INTEGER*2  (I-N) 

INTEGER* 2  SN,FLAG1(6) , FLAG 2 ( 4 ) ,NKEY(12S) , NRANK ( 128) , 

1  B (  1 2 8 )  ,  SUP 1 ( 1 2  8 )  , SUP  2(128), NCO ( 1 2  3 )  , NC I N ( 1 2  3 )  , 

2  NROQ28)  ,NTR(  128 ) , NTIN( 128 ) , NRIN ( 2  043 ) , 

3  NOROW( 2043 ) ,A( 123) 
REAL* 4  RMIN( 128) , RMAX ( 128) 

CHARACTER* 2 4  FNAME , COLMNE (12  8), MNE (128)  , MRANK (128)  , 
1  ROWMNEK  2048)  ,ROWMNE2( 123)  ,  IND,H1FNAME, 

H 2 FNAME 
LOGICAL*l  ST AT, ST ATI, ST AT 2 

I DUM= 1 

C      Loop  in  case  of  user  input  errors. 

DO  WHILE( IDUM.SQ. 1) 
IDUM=0 

C       Request   the   name   of   the   first   file  to  be  merged; 
C       examine  if  it  exists. 

WRITE ( IMP, 4  00) 

READ(LEC, 100)  HlFNAME 

INQUIRE(FILE=H1FNAME,EXIST=STAT1) 

C        If  does   not   exist  print  an  error  message  and   repeat 
C        the  request. 

IF  (STAT1.EQ. .FALSE. )  THEN 

WRITE( IMP, 300) 

I DUM= 1 
ELSE 
END  IF 

C      Request   the   name   of   the   second   file  to  be  merged; 
C      .examine  if  it  exists. 

WRITE( IMP, 500) 

READ(LEC, 100)  H2FNAME 

INQUIRE (FILE=H2 FNAME, EXIST- STAT 2) 

C         If  does   not   exist  print  an  error  message  and  repeat 
C        the  request. 

IF  (STAT2.EQ. .FALSE. )  THEN 

WRITE( IMP, 300) 

IDUM=1 
END  IF 

C    ,     If  both  files  exist,  request  name  for  the  new  file. 

IF  (STAT1.EQ. .TRUE. .AND. STAT2.EQ. .TRUE. )  THEN 
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WRITE( IMP, 700 ) 
READ(LEC, 100 )  FNAME 

C  Ex  am  i  n  e  if  the  file  exists. 

I NQU I  RE ( F I LE  =  FNAME , EX  I ST=STAT ) 

C         If  not,  request  if  column  or   row  merging  is  going  to 
C        be  executed. 

IF  ( STAT. EQ. .FALSE. )  THEN 
WRITE( IMP, 600) 
READ(LEC, 100)  IND 

C  If  row  merging  call  COMRCW 

IF  ( IND.EQ. ' 1 " )  THEN 

CALL  COMROW(LEC, IMP, LOGN,NCOL, NROW, FLAG 1 , 

1  FLAG2  ,  COLMNE  ,  NC  ,  NrCO  ,  NC  IN  ,  IJ  ,  A ,  3  , 

2  ROWMNE 1 , NR , NRO , NR I N , ROWMNE 2 , 

3  H 1 FNAME , H  2  FNAME , RM I N , RMAX , NT , 

4  NTR,NTIN) 
OPEN(UNIT=LOGN, F I LE= FNAME, STATUS = 'NEW  ) 
CALL  WRITER(LOGN,FLAGl , FLAG 2 , NCOL , NROW , KMN , 

1  NNU , NN , NM , I J , A , B , COLMNE , NC , NCO , 

2  NC I N , RMI N , RMAX , NT , NTR , NT  I N , NKEY , 

3  MNE , NRANK , MRANK , ROWMNE 1 , NR , NRO , 

4  NR I N, ROWMNE 2, SUP 1, SUP 2 ,SN,NORCW, 

5  NBRCW) 
ELSE  IF  (IND.EQ. '2')  THEN 

CALL  COMCOL(LEC, IMP , LOGN, NCOL , NROW , FLAG1 , 

1  FLAG2, COLMNE, NC, NCO, NC IN, IJ,A,B, 

2  ROWMNE 1 , NR , NRO , NR I N , ROWMNE  2 , 

3  HI FNAME , H 2  F N AME , RM I N , RMAX  , NT , 

4  NTR, NT  IN) 

OPEN (UN I T= LOGN, F I LE= FNAME, STATUS = ' NEW' ) 
CALL  WR I TER ( LOGN , FLAG1 , FLAG2 , NCOL , NROW , KMN , 

1  NNU , NN , NM , I J , A , 3 , COLMNE , NC , NCO , 

2  NC I N , RM I N , RMAX , NT , NTR , NT  I N , NKEY , 

3  MNE , NRANK , MRANK , ROWMNE 1 , NR , NRO , 

4  NRIN,R0WMNE2,SUP1,SUP2 ,SN,NORCW, 

5  NBROW) 
END  IF 

ELSE 

WRITE( IMP, 200) 
IDUM=1 
END  IF 
END  IF 
END  DO 
100    FORMAT (A2 4) 

200    FORMAT (///4X, 'THE  FILE  ALREADY  EXIST!!') 
300    FORMAT (///4X, 'THE  FILE  DOES  NOT  EXIST!!') 
400    FORMAT (///'$' ,3X, 'Name  of   first  Header' 's  file  :') 
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500 
600 


700 


r  ORMAr 


$'  r3X, 


Name  of  second  Header 


f  i 


FORMAT (///4X, 'Row  merging     :1'/4X, 

1  'Column  merging  :2', 

2  /*$' ,3X, 'Answer  : * ) 
FORMAT ( ' $ ' , 3X,    'Name   of   new   Head 
RETURN 
END 


'  ' 


i  ie 


s  file  :  '  ) 


SUBROUTINE  CRINFO(LEC, IMP, FLAG1 , FLAG2 , NCOL , NROW, COLMNE , 

1  NC , NCO , NC I N , ROWMNS 1 , NR , NRO , NR I N , 

2  ROWMNE 2 , RM I N , RMAX , NT , NTR , NT  I N , NKE Y , 

3  MNE  ,  NN  ,  NM  ,  I J  ,  A  ,  B  ,  NRANK  ,  MRANK  ,  NNU  ,  K.MN  , 

4  SUPI,SUP2 , SN,N0RCW,N3RCW) 


(2************** 

c 

c 

ARGUMENTS 

c 

c 

ARGUMENTS 

c 

c 

c 

LEC 

c 

c 

IMP 

c 

c 

LOGN 

c 

c 

FLAG1 

c 

c 

c 

FLAG2 

c 

NCOL 

c 

NROW 

c 

COLMNE 

c 

NC 

c 

NCO 

c 

c 

NCIN 

c 

ROWMNE 1 

c 

NR 

c 

NRO 

c 

c 

NRIN 

c 

ROWMNE  2 

c 

RM I N , RMAX 

c 

c 

c 

NT 

c 

c 

NTR 

c 

c 

NT  IN 

The  logical  unit  number  for   w 

terminal . 

The  logical  unit  number  for  re 

terminal . 

The  logical  unit  for  the   file 

header, s  data  will  be  stored. 

Integer  array  of  six   elements 

to  indicate   the   existence   o 

several  informations  regarding 

The  corresponding  flag  for  row 

The  number  of  columns. 

The  number  of  rows. 

Array  storing  the  column  mnemo 

The  number  of  assigned  column 

The   numbers  of  columns  for  wh 

assigned  names. 

The  invert  relative  addresses 

Array  storing  the  row  mnemonic 

The  number  of  assigned  row  mne 

The  numbers  of  rows   for   whic 

been  assigned. 

The  invert  relative  addresses 

Array  storing  the   mnemonics  o 

Arrays   storing   the   minimum 

values  between   which  tracing 

going  to  take  place. 

The   number  of   columns   for 

.extrema  have  been  assigned. 

The   column    numbers    for 

extrema  have  been  assigned. 

The  invert  relative  addresses 


r  i  t  ing  on   the 

ading  from  the 

on   which  the 

used  as  flag 
r   not   of  the 

the  columns. 
s . 

nic  names . 
mnemo  nic  n  am e  s 
ich  have   been 

of  COLMNE. 

names . 
monic  names, 
h   names   have 

of  ROWMNE. 
f  sets  of  rows 
and    maximum 
of  the  data  is 

which   tracing 

which   tracing 

of  RM I N , RMAX . 
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c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 


NKEY 

:  Array  storing   th 

will  be  used  as  s 

MNE 

:  Array  storing  the 

will  be  used  as  s 

NN 

:  The  number  of   re 

column  numbers. 

NM 

:  The   number  of  re 

column  mnemonic  n 

IJ 

:  The  number  of  ass 

A,B 

:  Arrays   storing  t 

starts   a   set  of 

corresponding  on 

NRANK 

:  Array  storing  the 

assign  the  rankin 

MRANK 

:  Array   storing   t 

assign  the  rankin 

NNU 

:  The  number  of  col 

KMN 

:  The  number  of  col 

SUP1,SUP2 

:  Arrays  storing  th 

starts   suppressi 

corresponding  on 

SN 

:  The  number  of  ass 

NOROW 

:  Array   the   numbe 

for  the  ranking  o 

NBROW 

:  The  number   of   r 

ranking 

e  numbers   or  columns  which 
orting  guides. 

names   of   columns   which 
ort  i  ng  cu  ides . 
peated   sortings   according 


sortings   according 


peated 
ames . 

igned   traci 
he   mumber  o 

common  nam 
which  ends  t 
numbers  o 
g  of  data 
he  names 
g  of  data 
umns  used  fo 
umn  names  u 
e  number  o 
on   of    row 

which  ends 
igned  suppre 
rs   of   rows 
f  the  rows, 
ow   numbers 


ng  extrema  sets 
f   row  on  which 
e  rows   and  the 
he  set. 
f   columns  that 


or   columns  chat 


r  rank  ing  . 
sed  for  ranking 
f  row  on  which 
s  and  the 
the  suppression 
ssions . 
used  as  guides 

used   for  row 


IMPLICIT    INTEGER*2     (I-N) 

INTEGER* 2    FLAGK6)  ,NCO(128)  ,  FLAG2  (  4  )  ,NKEY<  128)  , NTR(123  )  , 

1  SUPK128)  ,SUP2(128)  ,NRO(128)  ,NCIN(128)  , 

2  NTIN( 128) ,NRIN( 2048) ,NORCW( 2048 ) , SN, NRANK ( 123 ) 
REAL*4  RMINQ28)  ,RMAX(128) 

CHARACTER* 1  IND 

CHARACTER*  2  4  COLMNE (12  8)  , MNE (123), MRANK (128), 

1  ROWMNE1 ( 2048 ) ,ROWMNE2( 128) 

NBYTES=NCOL*4 

IDUM=1 

DO  WHILE  ( IDUM.EQ. 1) 

IDUM=0 

WRITE  (IMP, 100) 

READ  (LEC,20  0)  IND 

IF  ( IND.EQ. ' 1 ' )  THEN 

CALL  COLINF(LEC, IMP, FLAG 1 , NCOL , NROW , COLMNE , NC , 

1  NCO , NC I N , RM I N , RMAX , NT , NTR , NT  I N , NKEY , 

2  MNE , NN , NM , NRANK , MRANK , NNU , KMN ) 
IDUM=1 

ELSE  IF  (IND.EQ. '2')  THEN 

CALL  ROWINF(LEC, IMP,FLAG2 , NCOL , NROW , ROWMNE1 , 

1  NR,NRO,NRIN,ROWMNE2, IJ , A , B , SUP1 , SUP2 , 

2  SN, NOROW, NBROW) 
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100 


200 
300 


IDUM=1 

ELSE  IF  (IND.EQ.'   ')  THEN 

RETURN 
ELSE 

WRITE( IMP, 300) 
IDUM=1 
END  IF 
END  DO 
FORMAT  (///4X, ' Column  information 

1  'Row  information 

2  'Answer 
FORMAT  (A24) 

FORMAT {//SX, ' INVALID  CHARACTER! ! ' ) 
END 


1V4X, 

2' ,/*?' ,3X, 


************************************************************** 

SUBROUT I NE  COL  I NF ( LEC ,  I MP , FLAG 1 , NCOL , NROW , COLMNE , NC , NCO , 

1  NC I N , RM I N , RMAX , NT , NTR , NT  I N , NKEY , MNE , 

2  NN , NM , NRANK , MRANK , NNU , KMN ) 


c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 


ARGUMENTS 

LEC 
IMP 
FLAG1 


FLAG2 

NCOL 

NROW 

COLMNE 

NC 

NCO 

NCIN 

RM I N , RMAX 


NT 

NTR 

NT  IN 
NKEY 

MNE 

NN 


The  logical  unit  number  for   wri 

terminal . 

The  logical  unit  number  for  read 

terminal . 

Integer  array  of   six   elements 

to   indicate   the   existence   or 

several  informations  regarding  t 

The  corresponding  flag  for  rows. 

The  number  of  columns. 

The  number  of  rows. 

Array  storing  the  column  mnemoni 

The  number  of  assigned  column  mn 

The  numbers  of   columns  for  whic 

been  assigned. 

The  invert  relative  addresses  of 

Arrays   storing   the    minimum  a 

values  between  which   tracing  of 

going  to  take  place. 

The   number  of   columns  for    wh 

extrema  have  been  assigned. 

The  column  numbers  for  which  tra 

have  been  assigned. 

The  invert  relative  addresses  of 

Array  storing  the   numbers   of  c 

will  be  used  as  sorting  guides. 

Array   storing   the   names   of  c 

will  be  used  as  sorting  guides. 

The  number   of   repeated   sortin 

column  numbers. 


ting  on   the 

i ng  from  the 

used  as  flag 
not  of  the 
he  columns. 


c  names, 
emonic  names 
h  names  have 

COLMNE . 
nd    maximum 
the  data  is 

ich   t rac  ing 

cing  extrema 

RM I N , RMAX . 
olumns  which 

olumns  which 

gs  according 
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C  MM        :  The  number   of   repeated   sortings  according 

C  column   mnemonic  names. 

C  NRANK      :  Array  storing   the   numbers   of  columns  that 

C  assign  the  ranking  of  data 

C  MRANK      :  Array  storing   the   names   of   columns   that 

C  assign  the  ranking  of  daca 

C  NNU        :  The  number  of  columns  used  for  ranking. 

C  KMN        :  The  number  of  column  names  used  for  ranking. 

C 

IMPLICIT  INTEGER*2  (I-N) 

INTEGER*  2  FLAGK6)  ,  NT  IN  (  128)  ,  NKEY  (  123)  ,  NRANK  (  128)  , 

1  NCOQ28)  ,NCIN(128)  ,NTR(  123) 

REAL*4  RMIN( 128) , RMAX ( 123) 

CHARACTER* 2  IND 

CHARACTER* 2 4  COLMNEQ28)  , MNE(128)  ,  MRANK  (  123) 

IDUM=1 

DO  WHILE  ( IDUM.EQ.l) 
IDUM=0 

WRITE( IMP, 100) 
READ  (LEC,200)  IND 
IF  (  IND.EQ.  *  1 '  )  THEN 
WRITE( IMP, 500) 
READ(LEC,60  0)  NCL 
IF  (NCL.LE.128)  THEN 

NCOL=NCL 
ELSE 

WRITE( IMP, 800) 
IDUM=1 
END  IF 
IDUM=1 
ELSE  IF  (IND.EQ.' 2')  THEN 
IF  (NCOL.NE.0)  THEN 

CALL  COLNAM( LEC , IMP , FLAG1 , NCOL , COLMNE , NC , NCO , 
1  NCIN) 

IDUM-1 
ELSE 

WRITE( IMP,400) 
IDUM-1 
END  IF 
ELSE  IF  (IND.EQ.' 3')  THEN 
IF  (NCOL.NE.0)  THEN 

CALL  TRSFRM ( LEC , IMP , FLAG1 , NCOL , NROW , COLMNE , NC , 
1  NCO, NCIN) 

IDUM=1 
ELSE 

WRITE( IMP, 400) 
■  IDUM=1 
END  IF 
ELSE  IF  (IND.EQ.' 4')  THEN 
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IF  (NCOL.NE.O)  THEN 

CALL  EXTREM ( LSC , I MP , FLAG I , NCCL , NROW , RM I N , RMAX , 
1  NT,NTR,NTIN) 

IDUM=1 
ELSE 

WRITE( IMP, 400) 

IDUM=1 
END  IF 
ELSE  IF  (IND.EQ.'5')  THEN 
IF  (NCOL.NE.O)  THEN 

CALL  MULSOR ( LEC ,  IMP  , NCOL , NROW , FLAG 1 , NKEY , MNE , 
1  NN,NM, COLMNE) 

IDUM=1 
ELSE 

WRITE( IMP, 400) 

IDUM=1 
END  IF 
ELSE  IF  (IND.EQ.'b')  THEN 
IF  (NCOL.NE.O)  THEN 

CALL  RANDOM (LEC, IMP, NCOL, NROW) 

IDUM=1 
ELSE 

WRITE( IMP, 400 ) 

IDUM=1 
END  IF 
ELSE  IF  ( IND.EQ. ' 7' )  THEN 
IF  (NCOL.NE.O)  THEN 

CALL  CRANK ( LEC , I MP , NCOL , NROW , FLAG 1 , NRANK , MRANK , 
1  NNU,KMN,COLMNE) 

IDUM=1 
ELSE 

WRITE( IMP, 400) 

IDUM=1 
END  IF 
ELSE  IF  (IND.EQ. '8')  THEN 

CALL  CD  ISP  (LEC,  IMP , FLAG 1 , NCOL , COLMNE , NC , NCO , NC IN , 

1  RM I N , RMAX , NT , NTR , NT  I N , NKEY , MNE , 

2  NN , NM , NRANK , MRANK , NNU , KMN ) 
IDUM=1 

ELSE  IF  (IND.EQ.' 9")  THEN 

CALL  COLMOD  ( LEC , IMP , FLAG1 , NCOL , NROW , COLMNE , NC , 

1  NCO , NC I N , RMI N , RMAX , NT , NTR , NT  I N , NKEY , 

2  MNE , NN , NM , NRANK , MRANK , NNU , KMN ) 
IDUM=1 

ELSE  IF  ( IND.EQ.  ' 10  *  )  THEN 

IF  (NCOL.NE.O .AND. NROW. NE.0)  THEN 

CALL  SEEDAT ( LEC , IMP , NCOL , NROW ,1,1) 

IDUM=1 
ELSE 

WRITE( IMP, 700) 

IDUM=1 
END  IF 


112 


100 


200 
300 
400 

500 
600 
700 

800 


ELSE  IF  ( IND.EQ. ' 11' )  THEN 

I F  ( NCOL . NE . 0 . AND . NROW . NE . 0 ) 
CALL  DISDAT(LEC, IMP 
IDUM=1 


HEN 
NCOL,NRCW, 1,1) 


ELSE 

WRITE( IMP, 700) 
IDUM=1 

END  IF 
ELSE  IF  (IND.EQ.'   ')  THEN 

RETURN 
ELSE 

WRITE ( IMP, 3  00) 
IDUM=1 
END  IF 
END  DO 
FORMAT ( ///4X, ' SELECTION  TABLE  FOR  COLUMN  INFORMATIONS' 


1 

2 

3 

4 

5 

6 

7 

8 

9 

1 

2 

3 

4 

FORMAT 

FORMAT 

FORMAT 

1 

FORMAT (// 

FORMAT ( I  5 

FORMAT  i' 

1 

FORMAT 

1 

RETURN 

END 


4X, 


7X, 


3X, 


Number  of  columns  (mandatory 
Mnemonic  names 
Trans  format  ions 
Tracing  extrema 
Multi-sorting  column  guides 
Randomization  of  data 
Column  ranking 
Display  column  informations 
Modification  of  column  info 
Data  retrieval 
Display/print  of  data  file 
Answer  : ' ) 


l'/7X, 
277X, 
377X, 
4V7X, 
5' /7X, 
/7X, 
/7X, 
/7X, 
/7X, 
10' /7X, 
U'// 


'$ 

(A24) 

//3X, ' INVALID  CHARACTER! ! ' ) 
///4X, 'NUMBER  OF  COLUMNS  HAS 
/10X,  '  ASSIGNED! ! ' ) 
$ ' , 3X, ' Ass ign  number  of  columns 


NOT  BEEN' 


4X,' NUMBER  OF  COLUMNS  AND  ROWS  MUST  BE' 

/12X, 'ASSIGNED  TO  DISPLAY  THE  DATA  FILE!!') 
///4X,'THE  ASSIGNED  NUMBER  OF  COLUMNS  EXEEDS ' / 
4X,'        THE  MAXIMUM  PERMITTED  128') 


SUBROUTINE  ROWINF(LEC, IMP, FLAG 2 , NCOL , NROW , ROWMNE 1 , NR , 

1  NROW,NRIN,ROWMNE2 ,  I J , A , 3 , SUP  1 , SUP 2 , 

2  SN,NOROW,NBROW) 

Q*  ***********************************************************  * 

c 

C      This  subroutine  is  used  for  assignment  of   the   several 
C      row  informations 
C      ARGUMENTS 
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c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c*  *  * 


LEC 

:  The 

term 

IMP 

:  The 

term 

FLAG2 

:  The 

NCOL 

:  The 

NROW 

:  The 

ROWMNE 1 

Arra 

NR 

•  The 

NRO 

:  The 

been 

NRIN 

The 

ROWMNE 2 

Arra 

IJ 

The 

A,B 

Arra 

star 

cor  r 

SUP1,SUP2 

Arra 

star 

corr 

SN 

The 

NOROW 

Arra 

the 

NBROW 

The 

rank 

logical  uni 
.inal . 

logical  uni 
linal . 

correspondi 

number  of  c 

number  of 
iy  storing 

number  of 
numbers 
ass  igned . 

invert  rela 
iy  storing  t 

number  of  a 
iys  storing 
■ts  a  set  o 
•esponding  o 
iys  storing 
'ts  suppre 
•espond  ing 

number  of  a 
iy  the  numbe 

ranking  of 
number   of 

ing  . 


t  number  for   writing  on   the 

t  number  for  reading  from  the 

ng  flag  for  rows. 

olumns . 

ows . 

he  row  mnemonic  names. 

ss igned  row  mnemonic  names. 

f   rows   for  which  names  have 

tive  addresses  of  ROWMNE. 
he  mnemonics  of  sets  of  rows. 
ssigned  tracing  extreme  sets, 
the  mumber  of  row  on  which 
f  common  name  rows  and  the 
n  which  ends  the  set. 

the  number  of  row  on  which 
ssion  of  rows  and  the 
on  which  ends  the  suppression 
ssigned  suppressions, 
rs  of  rows  used  as  guides  for 
the  rows. 

row   numbers   used   for  row 


********************************************************** 


IMPLICIT  INTEGER*2  (I-N) 

INTEGER*2  SN,FLAG1(6) , FLAG2(4) ,  NKEY 

1  B(128)  ,SUP1(128)  ,SUP2(128 


12  8), NRANK 
,NRO( 128) , 


2  NRIN( 2048) , NOROW 

REAL*4  RMIN( 128) ,  RMAX  ( 128) 
CHARACTER* 2  IND 
CHARACTER* 7  MODROW 
CHARACTER* 2 4  FNAME , COLMNE ( 
1  ROWMNEK20  48) 

DIMENSION  NOCOL(256) 
DATA  MODROW/' rows ' / 


2048) ,A(128 


128)  , 
COMP (12  3) 


12  8), MNE 
, ROWMNE 2 


128) 
128) 


MRANK (12  8), 


IDUM=1 

DO  WHILE  ( IDUM.EQ. 1) 

IDUM=0 

WRITE( IMP, 100) 

READ (LEC, 20  0)  IND 

IF  ( IND.EQ. ' 1' )  THEN 
WRITE( IMP, 500) 
READ (LEC, 600 )  NROW 
I  D.UM=  1 

ELSE  IF  (IND.EQ.' 2')  THEN 
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I F  ( NROW . NE . 0 )  THEN 

CALL  ROWNAM  (  LEC  ,  IMP  ,  FLAG2  ,  NRCW  ,  ROWMNE 1  ,  NR  ,  NRG  , 
1  NR I N , ROWMNE 2 , IJ , A , B ) 

IDUM=1 
ELSE 

WRITE ( IMP, 4  00) 
IDUM=1 
END  IF 
ELSE  IF  ( IND.EQ. ' 3 ' ) THEN 
I F  ( NROW . NE . 0 )  THEN 

CALL  ROWSUP(LEC,  IMP  ,  FLAG2  ,  NCOL  ,  NROW  ,  SUPI  , SUP2, 
1  SN,ROWMNE2, A, 3) 

IDUM=1 
ELSE 

WRITE( IMP, 400) 
IDUM=1 
END  IF 
ELSE  IF  (IND.EQ.' 4')  THEN 

CALL  REJECT (LEC, IMP, NROW, IJCOMP , 1,1,1,1,1) 
IDUM=1 
ELSE  IF  (IND.EQ.' 5')  THEN 

CALL  ANAD I S ( LEC , IMP , NROW , NROW , NOROW , N3RCW , MODROW ) 
CALL  REORD(LEC, IMP , NCOL , NROW , FLAG2 , NOROW, NBROW) 
IDUM=1 
ELSE  IF  (IND.EQ. '6')  THEN 

CALL  RDISP  (LEC, IMP, FLAG2 , NROW, ROWMNE 1 , NR , NRO , 

1  NRIN,ROWMNE2, IJ , A , B , SUPI , SUP2 ,SN, 

2  NOROW, NBROW) 
IDUM=1 

ELSE  IF  (IND.EQ, '7')  THEN 

CALL  ROWMOD ( LEC , IMP , FLAG2 , NCOL , NROW , ROWMNE 1 , NR , NRO , 

1  NRIN,ROWMNE2, I J , A , B , SUPI , SUP2 ,SN,NCRCW, 

2  NBROW) 
IDUM=1 

ELSE  IF  (IND.EQ. '8')  THEN 

IF  (NCOL.NE.O .AND. NROW. NE.O )  THEN 

CALL  SEEDAT ( LEC , IMP , NCOL , NROW ,1,1) 

IDUM=1 
ELSE 

WRITE( IMP, 700 ) 

IDUM=0 
END  IF 
ELSE  IF  (IND.EQ. '9')  THEN 

IF  ( NCOL. NE. 0 .AND. NROW. NE. 0 )  THEN 

CALL  DISDAT(LEC, IMP , NCOL , NROW , 1,1) 

IDUM=1 
ELSE 

WRITE( IMP, 700) 

IDUM=0 
END  IF 
ELSE  IF  (IND.EQ. *   ' )  THEN 
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RETU 

ELSE 

WRIT 
IDUM 
END  IF 

END  DO 
10  0  FORMAT ( 

1 

2 

3 

4 

5 

6 

7 

8 

9 

1 

2 
2  00  FORMAT (A2 4 
300  FORMAT(/// 
400  FORMAT(/// 
500  FORMAT (//' 
60  0  F0RMAT(I3) 
700      FORMAT!/// 

1  / 

RETURN 

END 


RN 

E( IMP, 300 
=  1 


///4X, 
4X, 
7X, 


SELECTION  TABLE  FOR  ROW  INFORMATIONS'/' 


3X 


'Number  of  rows  (mandatory) 

'Mnemonic  names 

'Row  suppression 

' Row  re j  ect  ion 

'Row  ranking 

'Display  row  informations 

'Modification  of  row  info 

'Data  retrieval 

'Display/print  of  data  file 

' Answer  : ' ) 


1' /7X, 
2 '/7X, 

3V7X, 
/7X, 
/7X, 
/7X, 

/7X, 
/7X, 

// 


) 

4X, " INVALID  CHARACTER! ! ' ) 

4X, 'NUMBER  OF  ROWS  HAS  MOT  BEEN  ASSIGNE 

$', 3X, ' Assign  number  of  rows  :') 

4X, 'NUMBER  OF  COLUMNS  AND  ROWS  MUST  BE' 
4X, 'ASSIGNED  TO  DISPLAY  THE  DATA  FILE!! 


D! 


C 


************************************************************* 
SUBROUT I NE  COLNAM ( LEC , I MP , FLAG1 , NCOL , COLMNE , NC , NCO , NC I N ) 


used   for   assignment   of   names  to 


al  unit  number   for   writing  on  the 

:al  unit  number  for  reading  from  the 

array   of  six  elements  used  as  flag 
ate   the   existence   or   not  of  the 
nformations  regarding  the  columns, 
ring  the  column  mnemonic  names, 
r  of  assigned  column  mnemonic  names 
rs  of  columns   for  which  names  have 
gned . 
t  relative  addresses  of  COLMNE. 


(2************************** 

c 

c 

This  subroutine  is 

c 

columns 

c 

ARGUMENTS 

c 

c 

c 

LEC 

The  logic 

c 

terminal . 

c 

IMP 

The  logic 

c 

terminal . 

c 

FLAG1 

I nteger 

c 

to   indie 

c 

several  i 

c 

COLMNE 

: 

Array  sto 

c 

NC 

! 

The  numbe 

c 

NCO 

: 

The  numbe 

c 

been  assi 

c 

NCIN 

* 

The  inver 

c 

(2************************** 
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IMPLICIT  INTEGER*2  (I-N) 

INTEGER* 2  LEC, IMP , NCOL, FLAG1 ( 6 ) ,NCO( 128) ,NCIN( 128 ) 

CHARACTER*24  COLMNE ( 128 ), NAME 

FLAG1(1)=1 
1  =  1 
NC=1 

DO  WHILE  ( I .NE.O) 
WRITE( IMP, 100) 
READ (LEC, 20  0)  I 
IF  (I.LE.NCOL)  THEN 
IF  (I.EQ.O)  THEN 
NC=NC-1 

CALL  EXSH1 (NCO,NCIN,NC, 1) 
RETURN 
ELSE 

NCO ( NC ) = I 
WRITE( IMP, 300) 
READ (LEC, 400)  NAME 
COLMNE (NC)= NAME 
END  IF 
ELSE 

WRITE( IMP, 500) 
END  IF 
NC=NC+1 
END  DO 

100      FORMAT (/'$', 3X, 'Assign  column  number(<CR>  to  RETURN)  :' 

20  0      F0RMAT(I5) 

300      FORMAT ('$' ,3X, 'Assign  mnemonic  :') 

400      FORMAT (A2 4) 

500      FORMAT (//4X, 'THE  ASSIGNED  COLUMN  NUMBER  EXEEDS  ', 

1  /7X, 'THE  NUMBER  OF  COLUMNS! ! ' ) 

RETURN 

END 


Q****************  ************************************  x  ****-K  *  ■*  * 

SUBROUTINE  TRSFRM(LEC, IMP, FLAG 1 , NCOL , NRCW , COLMNE , NC , NCO , 
1  NC I N ) 

(2************************************************************* 

C 

C      ARGUMENTS 

C      

c 

C      LEC 

C 

C      IMP 

C 

C      FLAG1 

C 

C 

C      NCOL 


The  logical  unit  number  for   writing   on  the 

terminal . 

The  logical  unit  number  for  reading  from  the 

terminal . 

Integer  array   of  six   elements  used  as  flag 

to  indicate   the   existence   or   not   of  the 

several  informations  regarding  the  columns. 

The  number  of  columns. 
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c 

NROW 

c 

COLMNE 

c 

NC 

c 

NCO 

c 

c 

NC  I N 

c 

The  number  of  rows. 

Array  storing  the  column  mnemonic  names. 

The  number  of  assigned  column  mnemonic  names 

The  numbers  of   columns  for  which  names  have 

been  assigned. 

The  invert  relative  addresses  of  COLMNE. 


IMPLICIT  INTEGER*2  (i-N) 
INTEGER* 2  FLAGl(b) , NCO ( 1 2  8 ) , NC I N ( 1 2  3 ) 
CHARACTER*24  COLMNE ( 128 ), TRANS 
FLAG1(1)=1 
WRITE ( IMP, 100) 
INDEX=NC 
TRANS =' A* 

DO  WHILE(TRANS.NE.  '  '  ) 
READ(LEC,2  00)  TRANS 
I F  ( TRANS . NE . '   ' )  THEN 

NC=NC+1 

NCO(NC)=NCOL+l 

COLMNE (NC)=TRANS 

NCOL=NCOL+l 
END  IF 
END  DO 

CALL  EXSH1(NC0,NCIN,NC, 1) 
CALL  CONV ( NCOL , NRCW , COLMNE , NC , I NDEX ) 


100 


FORMAT(///6X, 'AVAILABLE  FUNCT IONS ' /6X , 


200 


1 
2 
3 

4 

5 

6 

7 

8 

9 

1 

FORMAT (A2 4) 

RETURN 

END 


■LOGC[X] 
■LOG[X] 

■expCx] 

•ABsix] 
•SIN[X] 
■COSCX] 
■TAN[X] 
•ASINH[X 


,4X, 
,4X, 
,4X, 
,4X, 
,4X, 
,4X, 
,4X, 
//2X, 


10 
11 
12 
13 
14 


V2X, 

9.-ASIN[X 
-ACOS[X 
-ATAN[X 
-SINH[X 
-COSH[X 
-TANH[X 


/2X 
/2X 
/2X 
/2X 
/2X 
/2X 
15.-SQRT[X] ' /2X 


l  » 


Assign  transformations  :'/) 


SUBROUT I NE  EXTREM ( LEC , IMP, FLAG 1 , NCOL , NRCW , RM I N , RMAX , NT , 
1  NTR,NTIN) 

Q-k-k-k  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * 

c 

C      This   subroutine   is   used   for   assignment   of  tracing 

C  extrema 

C 

C  ARGUMENTS 
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c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c*** 


LEC 

IMP 
FLAG1 


NCOL 
RMIN,RMAX 


NT 

NTR 


The  logical  unit  number   for   writing  on  the 

terminal . 

The  logical  unit  number  for  reading  from  z'r.e 

terminal . 

Integer   array  of  six   elements  used  as  flag 

to   indicate   the   existence  or   not   of  the 

several  informations  regarding  the  columns. 

The  number  of  columns. 

Arrays   storing   the   minimum    and   maximum 

values  between  which  tracing  of   the  data  is 

going  to  take  place. 

The   number  of  columns   for   which    tracing 

extrema  have  been  assigned. 

The  column  numbers  for  which  tracing  extrema 

have  been  assigned. 

The  invert  relative  addresses  of  RM IN, RMAX. 


NT  IN 

IMPLICIT  INTEGER*2  (I-N) 

INTEGER*  2  LEC,  IMP,  NCOL,  FLAGK6)  ,NTR(  128  )  ,  NT  IN  (128) 
REAL*4  RMINQ28)  ,  RMAX  (  128)  ,FMIN(  128)  ,  FMAX  (  128) 
CHARACTER* 1  IND 

FLAG1(2)=1 

CALL  FINDMM(LEC, IMP , NCOL , NROW , FMIN , FMAX ) 
IDUM=1 

DO  WHILE  ( IDUM.EQ. 1) 
IDUM=0 

WRITE( IMP, 100) 
READ  (LEC, 200)  IND 
IF  ( IND.EQ. '0' )  THEN 

RETURN 
ELSE  IF  (IND.EQ.'l')  THEN 
1  =  1 
NT=1 

DO  WHILE  ( I .NE.O ) 
WRITE( IMP, 700) 
READ(LEC,800)  I 
IF  (I. NE.O)  THEN 
NTR(NT)=I 

WRITE( IMP, 300 )  FMIN(I) 
READ(LEC,4  00)  RMIN(NT) 
WRITE ( IMP, 50  0)  FMAX(I) 
READ(LEC,4  00)  RMAX ( NT ) 
NT=NT+1 
END  IF 
END  DO 
-  NT=NT-1 
ELSE  IF  (IND.EQ. '   '  )  THEN 
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100 


200 
300 
400 
500 
600 
700 
800 


RETURN 
ELSE 

WRITE( IMP, 600) 
IDUM=1 
END  IF 
END  DO 

CALL  EXSH1(NTR,NTIN,NT, 1) 
FORMAT(///4X, ' Imposed  extrema  for  tracing  :1'/4X 

1  'Original  extrema  :0'/'$',3X, 

2  ' Answer  :  '  ) 
FORMAT (A2 4) 

FORMAT( ' $ ' , 3X, 'MIN  (found)  :', F14 . 6 , 2X ,' Imposed 

FORMAT (F14. 6) 

FORMAT! ' $ ' , 3X, 'MAX  (found)  :', F14 . 6 , 2X ,' Imposed 

FORMAT (//3X, ' INVALID  CHARACTER! ! ' ) 

FORMAT (//'$', 3X, ' Assign  column  number (<CR>  to  RSr 

FORMAT (15) 

RETURN 

END 


iRN 


SUBROUT I NE  MULSOR ( LEC , I MP , NCOL , NROW , FLAG 1 , NKEY , MNE , NN , 

1  NM,COLMNE) 

p***********************************^ 

C 

C      This  subroutine   is   used   for   assignment   of   sorting 

C  column  guides 

C 

C  ARGUMENTS 

C  

c 

C      LEC 

C 

C      IMP 

C 

C      NCOL 

C      NROW 

C      FLAG1 

C 

C 

C      NKEY 

C 

C      MNE 

C 

C      NN 

C 

C      NM 

C 

C      COLMNE 

C 


The  logical  unit  number   for   writing  on  the 

terminal . 

The  logical  unit  number  for  reading  from  the 

terminal . 

The  number  of  columns. 

The  number  of  rows. 

Integer   array   of  six   elements  used  as  flag 

to   indicate   the   existence   or   not   of  the 

several  informations  regarding  the  columns. 

Array  storing   the   numbers   of  columns  which 

will  be  used  as  sorting  guides. 

Array  storing  the  names  of  columns  which  will 

be  used  as  sorting  guides. 

The   number   of   repeated  sortings   according 

column  numbers. 

The   number   of   repeated  sortings   according 

column  mnemonic  names. 

Array  storing  the  column  mnemonic  names. 
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IMPLICIT  INTEGER*2  (I-N) 

INTEGER* 2  FLAG! ( 6) , NKEY ( 128 ) 

CHARACTER* 1  IND 

CHARACTER* 7  MODCOL 

CHARACTER* 2 4  MNE ( 128) , COLMNE ( 128) 

DATA  MODCOL/' columns' / 

IDUM=1 

DO  WHILE  ( IDUM.SQ.l) 
IDUM=0 

WRITE( IMP, 100) 
READ (LEC, 20  0)  IND 
IF  ( IND.EQ. ' 1' )  THEN 

IF  (FLAGK4)  .EQ.O)  THEN 
FLAG1(3)=1 

CALL  ANAD I S ( LEC , IMP , NCOL , NCOL , NKEY , NN , MODCOL ) 
CALL  REARKLEC,  IMP , NCOL , NROW , NKEY , NN ) 
ELSE 

WRITE( IMP, 700) 
RETURN 
END  IF 
ELSE  IF  (IND.EQ. '2')  THEN 
IF  (FLAGK  1)  .EQ.l)  THEN 

IF  (FLAGK  3  )  .EQ.O  )  THEN 
FLAGK  4)  =1 
WRITE( IMP, 400) 

CALL  ASBYMN( LEC, IMP , NCOL , COLMNE , NM , MNE ) 
CALL  REAR2 ( LEC , IMP , NCOL , NROW , COLMNE , MNE , NM ) 
ELSE 

WRITE( IMP, 800 ) 
RETURN 
END  IF 
ELSE 

WRITE( IMP, 500 ) 
END  IF 
ELSE 

WRITE( IMP, 600) 
IDUM=1 
END  IF 
END  DO 
RETURN 

100      FORMAT(///4X, 'By  column  number  :1'/4X, 

1  'By  mnemonic  name  :2' 

2  /, ' $' ,3X, 'Answer  : ' ) 
200      FORMAT (A2 4) 

400      FORMAT(///4X, ' Assign  column  mnemonic  names  :') 

500      FORMAT (//4X, 'NO  MNEMONIC  NAMES  HAVE  BEEN  ASSINGED!!') 

600      FORMAT (//4X, ' INVALID  CHARACTER!!') 

700      FORMAT (//4X,  'MULT I -SORTING  GUIDES  HAVE  ALREADY  BEEN*/ 

1  9X  '  ASSIGNED  BY  MNEMONIC  NAMES') 

300      FORMAT(//4X, 'MULTI-SORTING  GUIDES  HAVE  ALREADY  BEEN'/ 
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1  9X  '  ASSIGNED  3Y  COLUMN  NUMBERS') 

END 

SUBROUT I NE  CRANK ( LEC , IMP , NCOL , NROW , FLAG 1 , NRANK , MRANK , 
1  NNU , KMN , COLMNE ) 

c 

C      This   subroutine   is   used   to  assign  column  ranking  by 

C      column  number  or  column  mnemonic  names. 

C 

C  ARGUMENTS 

C  

c 

C  LEC        :  The  logical  unit   number   for  writing  on  the 

C  terminal . 

C  IMP        :  The  logical  unit  number  for  reading  from  the 

C  terminal . 

C  NCOL       :  The  number  of  columns. 

C  NROW       :  The  number  of  rows. 

C  FLAG1      :  Integer   array  of  six   elements  used  as  flag 

C  to   indicate   the   existence  or   not   of  the 

C  several  informations  regarding  the  columns. 

C  NRANK      :  Array  storing  the   numbers   of   columns  thai: 

C  assign  the  ranking  of  data 

C  MRANK      :  Array   storing   the   names   of   columns  that 

C  assign  the  ranking  of  data 

C  NNU        :  The  number  of  columns  used  for  ranking. 

C  KMN        :  The  number  of  column  names  used  for  ranking. 

C  COLMNE     :  Array  storing  the  column  mnemonic  names. 

C 

IMPLICIT  INTEGER*2  (I-N) 

INTEGER* 2  LEC, IMP , NCOL , NNU , KMN , FLAG1 ( 6 ) , NRANK ( 123 ) 

CHARACTER* 1  IND 

CHARACTER* 7  MODCOL 

CHARACTER*  2  4  MNE (12  8), COLMNE (128), MRANK (128) 

DATA  MODCOL/' columns' / 

IDUM=1 

DO  WHILE  ( IDUM.EQ. 1) 
IDUM=0 

WRITE( IMP, 100) 
READ(LEC,400)  IND 
IF  ( IND.EQ. ' 1' )  THEN 

IF  (FLAGK6)  .EQ.O)  THEN 
FLAG1(5)=1 

CALL  ANADIS(LEC, I MP, NCOL* 2 , NCOL , NRANK , NNU , 
1  MODCOL) 

CALL  RANK1 (LEC, IMP , NCOL , NROW , NRANK , NNU ) 
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ELSE 

WRITE ( IMP, 700) 
RETURN 
END  I? 
ELSE  IF  (IND.EQ.'2')  THEN 
IF  (FLAGK5)  .  EQ  .  0  )  THEN 

IF  (FLAGI(l) . EQ. 1)  THEN 
FLAG1(6)=1 
WRITE ( IMP, 300) 

CALL  ASBYMN ( LEC , IMP , NCOL , COLMNE , KMN , MRANK ) 
CALL  RANK 2 ( LEC ,  IMP, NCOL , NRCW , MRANK , KMN , 
1  COLMNE) 

ELSE 

WRITE( IMP, 500) 
RETURN 
END  IF 
ELSE 

WRITE ( IMP, 8  00) 
END  IF 
ELSE 

WRITE( IMP, 600) 
IDUM=1 
END  IF 
END  DO 

100      FORMAT ( ///4X, ' 3y  column  mumber   :1'/4X, 

1  'By  mnemonic  names  :2'/ 

2  '$' ,3X, 'Answer  : ' ) 

300      FORMAT ( ///3X, ' Ass ign  ranking  by  sequence  of  names  :') 

40  0      FORMAT (A2 4) 

500      FORMAT (///4X, 'NO  MNEMONIC  NAMES  HAVE  BEEN  ASSINGED!!') 

600      FORMAT ( ///4X, ' INVALID  CHARACTER!!') 

70  0      FORMAT (///4X, 'RANKING  HAS  ALREADY  BE  ASSIGNED ' /6X, 

1  '  BY  COLUMN  MNEMONIC  NAMES! ! ' ) 

800      FORMAT (///4X, 'RANKING  HAS  ALREADY  BE  ASSIGNED ' /6X, 

1  '  BY  COLUMN  NUMBERS ! ! ' ) 

RETURN 

END 

SUBROUTINE  ASBYMN  ( LEC , IMP , NCOL , COLMNE , N , AR ) 

C 

C      ARGUMENTS 

C      

c 

C  LEC  :  The  logical  unit   number   for   writing   on   the 

C  terminal . 

C  IMP  :  The  logical  unit  number  for   reading   from   the 

C  terminal. 

C  NCOL  :  The  number  of  columns. 

C  COLMNE  :  Array  storing  the  column  mnemonic  names. 
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C     N      :  The  number  of  the  assigned  mnemonics  (index). 

C     AR      :  Array  storing  the  assigned  mnemonics. 

C 

IMPLICIT  INTEGER*2  (I-N) 

INTEGER*2  NCOL , N 

CHARACTER* 2 4  COLMNE(128) ,AR(128) , NAME 

LOGICAL*!  TEST 

N=0 

NAME=' A' 

DO  WHILE  (NAME.NE. '   ' ) 
IDUM=1 

DO  WHILE ( IDUM.EQ. 1) 
IDUM=0 

READ(LEC,100)  NAME 

CALL  TESTER ( NCOL , NAME , COLMNE , TEST ) 
IF  (N.LT. NCOL) THEN 

I F  ( TEST . EQ . . TRUE . )  THEN 
N=N+1 

AR(N)=NAME 
ELSE  IF  ( TEST. SQ . . FALSE. .AND. NAME. ME. '   ')  THEN 
WRITE( IMP, 200) 
IDUM=1 
END  IF 
ELSE 

WRITE( IMP, 300) 
RETURN 
END  IF 
END  DO 
END  DO 
100      FORMAT (A2 4) 
200      FORMAT  (///4X,  'THE  ASSIGNED  MNEMONIC  HAS  NOT  BEENV6X, 

1  '  ASSIGNED  AS  COLUMN  MNEMONIC !!' //4X , 

2  'Assign  next  mnemonic') 

300      FORMAT(///4X, 'THE  ASSIGNED  NUMBER  OF  MNEMONICS  IS  ' 

1  /4X,  'GREATER  THAN  THE  NUMBER  OF  COLUMNS !!' /4X , 

2  "THE  LAST  ONE  IS  OMMITED') 
RETURN 

END 

p************************************ 

SUBROUTINE  ROWNAM ( LEC , IMP, FLAG 2 , NROW , ROWMNE 1 , NR , NRO , 
1  NR I N , ROWMNE  2 ,  I J , A , B ) 

c 

C      This  subroutine  is  used  for  assignment  of  row  mnemonics 

C 

C  ARGUMENTS 

C  

c 


124 


c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c** 


LEC 

IMP 

FLAG2 

NROW 

ROWMNE1 

NR 

NRO 

NRIN 
ROWMNE2 

IJ 
A,B 


The  log 
termina 
The  log 
termina 
The 
The 
Arra 
The 
The 
been 
The 
Arra 
The 
Arra 
star 
corr 


1. 


un  in 


numoe 


or 


ical  un 
1 . 

corresp 
number 
y  s  t  o  r  i 
number 
number 
ass  ign 
invert 
y  stori 
number 
ys  stor 
ts   a 
esoondi 


it  number  for 


wr 1 t ing 


eading 


on 


■om 


the 
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onding  flag  for  rows. 

of  rows. 

ng  the  row  mnemonic  names. 

of  assigned  row  mnemonic  name: 

s   of   rows  for   which  names 
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relative  addresses  of  ROWMNE. 

ng  the  mnemonics  of  sets  of  r 
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ing  the   mumber   of   row  on  w 

set  of  common   name  rows   and 
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IMPLICIT  INTEGER*2  (I-N) 

INTEGER* 2  LEC, I MP, NROW, IJ,FLAG2 (4) ,A(123) ,3(123) , 

1  NRO (128), NRIN (2048) 

CHARACTER* 1  I ND 

CHARACTER* 2 4  ROWMNE 1 ( 2  0  48 ) , ROWMNE 2 ( 1 2  8 ) , NAME 

IDUM=1 

DO  WHILE  ( IDUM.EQ.l) 
IDUM=0 

WRITE( IMP, 400) 
READ (LEC, 2  00 )  IND 
IF  ( IND.EQ. ' 1 ' )  THEN 
FLAG2(1)=1 
1  =  1 
NR=1 

DO  WH I LE ( I . NE . 0 ) 
WRITE( IMP, 510) 
READ(LEC, 100)  I 
IF  (I.EQ.0)  THEN 
NR=NR-1 

CALL  EXSH1(NR0,NRIN,NR, 1) 
RETURN 
ELSE 

NRO(NR)=I 
WRITE( IMP, 500) 
READ (LEC, 200 )  NAME 
ROWMNE 1(NR) =NAME 
END  IF 
NR=NR+1 
END  DO 
ELSE  IF  (IND.EQ.' 2')  THEN 
FLAG2(2)=1 
IJ  =  1 
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1  =  1 

DO  WHILE( I .NE.O) 
IDUM=1 

DO  WHILE( IDUM.EQ. I) 
IDUM=0 

WRITE( IMP, 600)  IJ 
READ! LEC, 100)  I 
IF  (I. NE.O)  THEN 

IF  ( I . LE . NROW )  THEN 

A( IJ)=I 
ELSE 

WRITE ( IMP, 800) 
IDUM=1 
END  IF 
ELSE 

IJ=IJ-1 
RETURN 
END  IF 
END  DO 
JDUM=1 

DO  WHILE ( JDUM.EQ. 1) 
JDUM=0 

WRITE ( IMP, 700) 
READ(LEC, 100)  J 
IF  (J.LE.NROW)  THEN 
B( IJ)=J 

WRITE ( IMP, 90  0 ) 
READ(LEC,200)  ROWMNE2 ( IJ 
IJ=IJ+1 
ELSE 

WRITE( IMP, 800) 
JDUM=1 
END  IF 
END  DO 
END  DO 
IDUM=1 
ELSE  IF( IND.EQ. '  ' )  THEN 

RETURN 
ELSE 

WRITE( IMP, 1000 ) 
IDUM=1 
END  IF 
END  DO 
RETURN 

10  0      FORMAT(I5) 

200      FORMAT (A2 4) 

400      FORMAT ( ///4X, ' Row  by  row 

1  ' By  set  of  rows 

2  'Answer 
500      FORMAT( '$', 3X, ' Assign  mnemonic 

510      FORMAT(/' $', 3X' Assign  row  number (<CR>  to  RETURN) 


126 


1V4X, 

2'/'$' ,3X, 


600      FORMAT (/// 4 X,  'Common  name  set  :  '  , I  5/ ' $ '  , 3X , 

1  ' From  row         :  '  ) 

700      FORMAT ('$' ,3X, 'To  row  :') 

300      FORMAT(///3X, 'THE  ASSIGNED  ROW  NUMBER  EXEEDS  THE  NUMBER 

1         *  OF  ROWS ! ! ' ) 
90  0      FORMAT ( ' $ ' , 3X, 'Name  :') 

1000     FORMAT ( ///5X, ' INVALID  CHARACTER!!') 

END 


SUBROUTINE  ROWSUP ( LEC , IMP,FLAG2 , NCOL , NRCW , SUPl , SUP2 ,  SN, 
1  ROWMNE  2 , A , 3 ) 

£xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx^ 

c 


c 

Row  suppr 

c 

ARGUMENTS 

c 

c 

c 

LEC 

c 

c 

IMP     : 

c 

c 

FLAG2 

c 

NCOL 

c 

NROW 

c 

SUP1,SUP2 

c 

c 

c 

SN 

c 

ROWMNE 2 

c 

A,B 

c 

c 

c 

wr  i  t  ing 


on 


ne 

he 


C 


The  logical  unit   number   for 

terminal . 

The  logical  unit  number  for   reading   from 

terminal . 

The  corresponding  flag  for  rows. 

The  number  of  columns. 

The  number  of  rows. 

Arrays  storing  the   number   of   row  on  which 

starts    suppression   of   rows    and      the 

corresponding  on  which  ends  the  suppression. 

The  number  of  assigned  suppressions. 

Array  storing  the  mnemonics  of  sets  of  rows. 

Arrays  storing  the   mumber   of   row  on  which 

starts   a   set  of  common   name   rows  and  the 

corresponding  on  which  ends  the  set. 

xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 


IMPLICIT  INTEGER*2  (I-N) 

INTEGER* 2  SN,FLAG2(4) ,SUP1( 128) , SUP2( 128) ,A( 128 

CHARACTER* 1  I ND 

CHARACTER* 2 4  NAME , ROWMNE2 ( 123 ) 

FLAG2( 3)=1 

WRITE( IMP, 50) 

READ(LEC,60)  I ND 

IF  ( IND.EQ. ' 1 ' )  THEN 

CALL  SUP (LEC, IMP , NCOL , NROW , SUPl , SUP2 ,SN) 
ELSE  IF  (IND.EQ. '2')  THEN 
IF  (FLAG2(2 ) . EQ . 1 )  THEN 
SN=1 

NAME= 'A' 

DO  WHILE(NAME.NE. *   * ) 
WRITE( IMP, 70 )  SN 
READ(LEC,80)  NAME 


,B(128 
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50 


60 

70 

80 

100 

200 

300 

400 

500 


1  =  1 

DO  WHI LE ( NAME . NE . ROWMNE 2(1)) 

1  =  1  +  1 
END  DO 

IF  (NAME.NE. '   ' )  THEN 
SUP1(SN)=A( I ) 
SUP2(SN)=B( I ) 
ELSE 

SN=SN-1 

CALL  SUPSET(LEC, IMP , NCOL , NROW , SUPl , SUP 2 ,SN) 
RETURN 
END  IF 
SN=SN+1 
END  DO 
ELSE 

WRITE( IMP, 500) 
RETURN 
END  IF 
END  IF 
FORMAT (///4X, ' By  mumber  of  rows  :1'/4X, 

1  'By  row  set  name    :2'/'$',3X, 

2  ' Answer  :  '  ) 
FORMAT (A) 

FORMAT(///4X,  ' Suppression  : ' 1 5 , / ' %  '  ,  3X, ' Set  name     :') 

FORMAT (A2 4) 

FORMAT(///4X,  'Suppression  : '  , I  5/ ' $ '  , 3X ,  ' From  row    :') 

FORMAT (15) 

FORMAT(///4X, 'THE  ASSIGNED  NUMBER  IS  GREATER  THAN  THE', 

1       /18X,  '  NUMBER  OF  ROWS') 

FORMAT ('$' ,3X, 'To  row      :') 

FORMAT (///4X, 'SETS  WITH  COMMON  MNEMONICS  HAVE'/ 

1         10X,       '  NOT  BEEN  ASSIGNED!!') 

END 


C 

c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
..  c 
c 
c 


SUBROUTINE  SUP ( LEC , IMP , NCOL , NROW , SUPl , SUP2 , SN ) 
(^*************  **  *  *  **  **  *  **  *  *  *  ****  *  *  *  *  *  *  *  *  ****  *  *  *  *  **  *  *  *  *  *  *  *  *  *  *  *  * 

C 

ARGUMENTS 


on 


the 
the 


LEC     :  The  Logical  unit   number   for   writing 

terminal . 
IMP     :  The  logical  unit  number  for   reading   from 

terminal . 
NCOL       :  The  number  of  columns. 
NROW       :  The  number  of  rows. 

SUP1,SUP2  :  Arrays  storing  the   number   of   row  on  which 
starts    suppression   of   rows     and     the 
corresponding   on  which  ends  the  suppression 
SN         :  The  number  of  assigned  suppressions. 
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IMPLICIT  INTEGER*2  (I-N) 

REAL*4  Y(128) 

INTEGER* 2  SN,S'JP1(  12S  )  , SUP2(  123)  ,NORCW(  2048  )  ,NO(  2048  ) 

CHARACTER*  7  MODROW 
CHARACTER* 4 5  DEVDI R , NAME* 10 

DATA  MODROW/' rows' /DEVOIR, NAME/ ' DUAO  :','  '/ 
1     LOGOLD,LOGNEW/2 , 3/ 

C     Assign  files. 
WRITE( IMP, 10  0 ) 
NBYTES=NCOL*4 
CALL  FICH  ('069'  , LOGOLD,l, DEVDI R, NAME, NROW , NBYTES , 1 , 

1  'DIRECT' ,LEC, IMP) 

WRITE( IMP, 200) 

NBYTES=NCOL*4 

CALL  FICH  ('  0  69'  , LOGNEW , 1 , DEVDI R, NAME , NROW, NBYTES, 0 , 

1  'DIRECT' ,LEC, IMP) 

C      Input  chain  of  numbers,  ','  or  '-'  to  assign 
C      suppressions. 

CALL  ANAD I S ( LEC , I MP , NROW , NROW , NOROW , NBROW , MODROW ) 

C      Sort  NOROW ( ) 

CALL  EXSH1 (NOROW, NO, N3RCW, 1) 

C     Phase   I  :  Copy  non-suppressed  Data. 
c      

J  =  0 
K=l 
DO  1=1, NROW 

READ     (LOGOLD'I)  ( Y( L) , L=l , NCOL) 
IF  ( I .EQ.NOROW(K) )  THEN 

K=K+1 
ELSE 

J=J  +  1 

WRITE( LOGNEW' J)  (Y(D , L=l,NCOL) 
END  IF 
END  DO 

C     Phase  II  :  SUP1,  SUP2  and  SN  generation  for  Header. 
c     

SUPK  l)=NOROW(  1) 

SN=0 

DO  1=1, NBROW 

IF ( NOROW (  1  +  1)  .NE. NOROW (  I  )  +1)  THEN 

SN=SN+1 

SUP2(SN   )=NOROW(I   ) 
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SUP1(SN+1)=N0R0W( 1+1) 
END  IF 
END  DO 

NROW=NROW-NBROW 
CLOSE (LOGOLD) 
CLOSE (LOGNEW) 

RETURN 

100      FORMATf/' $', 3X, ' Assign  no.  of  the  ''OLD''  direct', 

1       '  access  file  : V4X,44( '-' ) ) 
200      FORMAT(/' $', 3X, 'Assign  no.  of  the  ''NEW'  direct', 

1       '  access  file  : V4X,44( '-' ) ) 

END 

Q*  ***********************************************************  * 

SUBROUTINE  SUPSET ( LEC , IMP , NCOL , NROW, SUPl , SUP2 , SN ) 

Q  ************************************************************  * 

c 

C  Used  to  supress  the  rows  that  correspond  to  the  assigned 

C  set  with  common  name. 

C 

C  ARGUMENTS 

C  

c 

C  LEC     :  The  logical  unit   number   for   writing   on   the 
C  terminal . 

C  IMP     :  The  logical  unit  number  for   reading   from   the 
C  terminal . 


C  NCOL 
C  NROW 
C      SUP1,SUP2 


The  number  of  columns. 

The  number  of  rows. 

Arrays  storing  the  number  of  row  on  which 
C  starts   suppression   of    rows     and     the 

C  corresponding  on  which  ends  the  suppression. 

C     SN         :  The  number  of  assigned  suppressions. 

C 

q*  ***********************************************************  * 

IMPLICIT  INTEGER*2  (I-N) 
REAL*4  X( 128) , Y(128) 
INTEGER* 2  SN,SUP1( 128) ,SUP2( 128) 
CHARACTER* 4 5  DEVDI R , NAME* 10 

DATA  DEVDIR,NAME/'DUA0  :','   '/ 
DATA  LOGOLD, LOGNEW/ 2, 3/ 

C     Assign  files. 

WRITE( IMP, 100) 

NBYTES=NCOL*4 

CALL  FICH  (' 0  69 ', LOGOLD, 1, DEVDI R, NAME, NROW, MBYTES, 1 , 
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1  ' DIRECT' , LEC, IMP) 

WRITE( IMP, 200) 

NBYTES=NCOL*4 

CALL  FICH  ( ' 069' , LOGNEW, 1 , DEVDIR, NAME , NROW, NBYTES , 0 , 

1  'DIRECT' ,LEC, IMP) 

Supress  the  row  between  SUPlO  and  SUP2(). 


J=l 

1  =  1 
L=l 

DO  WHILE  (I .LE.NROW) 
IF  (J.LE.SN)  THEN 

IF  (SUPl(J) .NE. I )  THEN 

READ  (LOGOLD'I)  ( X ( K ) , K= 1 , NCCL ) 
WR I TE ( LOGNEW ' L )  ( X ( K ) , K= 1 , NCOL ) 
L  =  L+1 
1  =  1  +  1 
ELSE 

I=I+(SUP2( J)-SUP1(J)+1) 
IF  (J.LE.SN)  THEN 

J=J  +  1 
END    IF 
ExND    IF 
ELSE 

READ  (LOGOLD* I 
WRITE (LOGNEW  L 
L  =  L+1 
1  =  1  +  1 
END  IF 
END  DO 
NROW=L-l 
CLOSE (LOGOLD) 
CLOSE (LOGNEW) 


(X(K) ,K=l,NCOL 
(X(K) ,K=l,NCOL 


RETURN 


100  FORMAT(/' $', 3X, 'Assign  no.  of  the 
1       '  access  file  : ,/4X/44( '-' 

200      FORMAT(/' $', 3X, 'Assign  no.  of  the 

1       *  access  file  : '/4X,44( '-' ) ) 


' 'OLD' ' 
) 

*  *  NEW '  ' 


di reci '  , 

direct '  , 


END 

SUBROUTINE  WRITER( LOGN,FLAGl , FLAG2 , NCOL , NROW , KMN , NNU , NN , 

1  NM , I J , A , B , COLMNE , NC , NCO , NCI N , RMI N , RMAX , 

2  NT , NTR , NT  I N , NKEY , MNE , NRANK , MRANK , 

3  ROWMNEl,NR,NRO,NRIN,ROWMNE2 ,SUP1 ,SUP2 , 

4  SN,NOROW,NBROW) 
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c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 


This   subroutine  is  used 
regarding  the  header  on  a 

ARGUMENTS 


to    write   tne 
seauential  file. 


inf ormat ions 


LOGN 
FLAG1 


FLAG2 

NCOL 

NROW 

KMN 

NNU 

NN 

NM 

IJ 
A,B 


COLMNE 

NC 

NCO 

NCIN 
RMIN,RMAX 


NT 

NTR 

NT  IN 
NKEY 

MNE 

NRANK 

MRANK 

ROWMNE1 

NR 

NRO 

NRIN 

ROWMNE2 

SUP1,SUP2 


on 


w  n  i  c  n 


ne 


The  logical  unit   for  the  file 

header, s  data  will  be  stored. 

Integer   array  of  six  elements  used  as   flag 

to   indicate   the   existence   or  not  of   the 

several  informations  regarding  the  columns. 

The  corresponding  flag  for  rows. 

The  number  of  columns. 

The  number  of  rows. 

The  number  of  column  names  used  for  ranking. 

The  number  of  columns  used  for  ranking. 

The   number  of  repeated    sortings  according 

column  numbers. 

The   number   of  repeated  sortings   according 

column  mnemonic  names. 

The  number  of  assigned  tracing  extrema  sets. 

Arrays   storing   the   mumber  of  row  on  which 

starts   a   set   of  common  name  rows   and  the 

corresponding  on  which  ends  the  set. 

Array  storing  the  column  mnemonic  names. 

The  number  of  assigned  column  mnemonic  names 

The  numbers  of  columns  for  which  names   have 

been  assigned. 

The  invert  relative  addresses  of  COLMNE. 

Arrays   storing   the   minimum   and    maximum 

values   between  which  tracing  of  the  data  is 

going  to  take  place. 

The   number  of   columns  for   which 

extrema   have  been  assigned. 

The  column  numbers  for  which  tracing 

have  been  assigned. 

The  invert  relative  addresses  of  RMIN,RMAX. 

Array  storing   the  numbers  of  columns   which 

will  be  used  as  sorting  guides. 

Array   storing   the   names   of  columns  which 

will  be  used  as  sorting  guides 

Array  storing   the  numbers   of 

assign  the  ranking  of  data 

Array  storing   the   names   of 

assign  the  ranking  of  data. 

Array  storing  the  row  mnemonic 

The  number  of  assigned  row  mnemonic  names. 

The   numbers   of   rows   for  which  names  have 

been  assigned. 

The  invert  relative  addresses  of  ROWMNE . 

Array  storing  the  mnemonics  of  sets  of  rows. 

Arrays  storing  the   number   of   row  on  which 


rac 1 ng 


ex 


'em  a 


columns  that 
columns  that 
names . 
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C  starts   suppression   of    rows 

C  corresponding  on  which  ends  the  suppression. 

C  SN         :  The  number  of  assigned  suppressions. 

C  NOROW      :  Array  the  numbers  of  rows  used  as  guides  for 

C  the  ranking  of  the  rows. 

C  N3R0W      :  The   number   of   row   numbers   used   for  row 

C  ranking. 

C 


IMPLICIT  INTEGERS  (i-N) 

INTEGER* 2  SN,FLAG1(6) , FLAG2 ( 4 ) ,A(128 ) ,3(123) , NKSY ( 128 ) , 

1  NRANKQ2S)  ,SUP1(128  )  ,SUP2(128  )  ,NCO(  123  )  , 

2  NC I N ( 1 2  8 )  , NRO (12  8), NTR ( 1 2  8 ) , NT I N ( 1 2  8 ) , 

3  NRIN( 2048 ) ,NORCW( 2048) 
CHARACTER*  2  4  COLMNE (12  8), MNE (128), MRANK (128)  , 
1  ROWMNE1 ( 2048 ) ,ROWMNE2( 128) 

REAL  *  4  RM I N ( 1 2  8 )  , RMAX (128) 

WR I TE  (  LOGN  ,200)  NCOL  ,  NROW  ,  NC  ,  NR ,  IJ  ,  NT  ,  KMN  ,  NNU  ,  NN  ,  NM  ,  S  N' , 
1  NBROW 

WRITE(LOGN, 100)  ( FLAG1 ( I )  ,  I  =  1  ,  6  ) 


IF  (FLAGl(l) . EQ. 1 
WRITE (LOGN, 300 
WRITE (LOGN, 100 
WRITE(LOGN, 100 

END  IF 

IF  (FLAGK2)  .EQ.  1 
WRITE (LOGN, 400 
WRITE (LOGN, 400 
WRITE (LOGN, 10  0 
WRITE(LOGN, 100 

END  IF 

WRITE(LOGN, 100)  ( 

IF  (FLAG2( 1) .EQ. 1 
WRITE(LOGN, 300 
WRITE(LOGN, 100 
WRITE(LOGN, 100 

END  IF 

IF  (FLAG2(2) . EQ . 1 
WRITE(LOGN, 300 
WRITE (LOGN, 100 
WRITE (LOGN, 100 

END  IF 

IF  (FLAGK  3)  .EQ.  1 
WRITE(LOGN, 100 

END  IF 

IF  (FLAGK4)  .EQ.  1 
WRITE (LOGN, 3  00 

END  IF 

IF  (FLAGK  5)  .EQ.  1 
WRITE(LOGN, 100 


THEN 

( COLMNE ( I) , 1=1 ,NC) 
( NCO ( I ) , I = 1 , NC ) 
( NC I N ( I ) , I = 1 , NC ) 

THEN 

( RM I N (  I  )  ,  I  =  1 , NT ) 
( RMAX ( I ) , I = 1 , NT ) 
(NTR( I) , 1=1, NT) 
( NT I N ( I ) , I = 1 , NT ) 

FLAG2(  I)  ,  1  =  1,4) 
THEN 

( ROWMNE 1 ( I ) , I = 1 , NR ) 
(NRO( I) , I=1,NR) 
(NRIN( I ) , I=1,NR) 

THEN 

(ROWMNE2 ( I ) , 1=1, IJ) 

(A( I ) , 1=1, IJ) 

(B( I ) , 1=1, IJ) 

THEN 

(NKEY( I ) , 1=1 ,NN) 

THEN 

( MNE ( I ) , I = 1 , NM ) 

THEN 

( NRANK ( I ) , I = 1 , NNU ) 
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100 
200 
300 

400 


END  IF 

IF  (FLAGK6)  .EQ.l) 

WRITE! LOGN, 300) 
END  IF 
IF  (FLAG2(3) . EQ . 1 ) 

WRITE (LOGN, 100) 

WRITE (LOGN, 100) 
END  IF 
IF  (FLAG2U)  .EQ.l) 

WRITE ( LOGN, 100) 
END  IF 
FORMAT (15) 
FORMATQ2I5) 
FORMAT (X,A2 4 ) 
FORMAT (Fl 4 .6) 
RETURN 
END 


THEN 
( MRANK 

THEN 
(SUPK  I  ) 
(SUP2(  I  ) 


) , I = 1 , KMN 


1  =  1 
1  =  1 


THEN 
( NOROW 


SN 
SN 


I  )  ,  I  =  l,NBROW 


************************************************************** 

SUB ROUT  I NE  READER ( LOGN , FLAG1 , FLAG 2 , NCOL , NROW , KMN , NNU , NN , 

1  NM , I J , A , B , COLMNE , NC , NCO , NC IN, RMIN, RMAX , 

2  NT , NTR , NT  I N , NKEY , MNE , NRANK , MRANK , 

3  ROWMNE 1 , NR , NRO , NRI N , ROWMNE 2 , SUP 1 , SUP  2 , 

4  SN, NOROW, NBROW) 
*********************************************************** 


C** 

c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 


This   subroutine  is   used   to   record   the 
regarding  the  header  on  a  sequential  file. 


inf ormat  ions 


ARGUMENTS 


LOGN 
FLAG1 


FLAG2 

NCOL 

NROW 

KMN 

NNU 

NN 

NM 

IJ 
A,B 


COLMNE 
NC 


The  logical  unit  fo 
header, s  data  will  b 
Integer  array  of  si 
to  indicate  the  e 
several  informations 
The  corresponding  fl 
The  number  of  column 
The  number  of  rows. 
The  number  of  column 
The  number  of  column 
The  number  of  repea 
column  numbers. 
The  number  of  repe 
column  mnemonic  name 
The  number  of  assign 
Arrays  storing  the 
starts  a  set  of  c 
corresponding  on  whi 
Array  storing  the  co 
The  number  of  assign 


r  the  file  on   which  the 
e  stored. 

x  elements  used  as   flag 
xistence   or  not  of   the 

regarding  the  columns. 
ag  for  rows. 
s . 

names  used  for  ranking. 
s  used  for  ranking, 
ted    sortings  according 

ated  sortings   according 
s . 

ed  tracing  extrema  sets, 
mumber  of  row  on  which 
ommon  name  rows   and  the 
ch  ends  the  set . 
lumn  mnemonic  names, 
ed  column  mnemonic  names 
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c 

NCO 

c 

c 

NCIN 

c 

RM I N , RMAX 

c 

c 

c 

NT 

c 

c 

NTR 

c 

c 

NT  IN 

c 

NKEY 

c 

c 

MNE 

c 

c 

NRANK 

c 

c 

MRANK 

c 

c 

ROWMNS1 

c 

NR 

c 

NRO 

c 

c 

NRIN 

c 

ROWMNE2 

c 

SUP1,SUP2 

c 

c 

c 

SN 

c 

NOROW 

c 

c 

NBROW 

c 

c 

£************** 

The  numbers  of  columns  for 

been  assigned. 

The  invert  relative  addresses  o 
Arrays   storing   the   minimum 
values   between  which  tracing  o 
going  to  take  place. 
The   number  of   columns  for   vh 
extrema   have  been  assigned. 
The  column  numbers  for  which  tr 
have  been  assigned. 
The  invert  relative  addresses  o 
Array  storing   the  numbers  of  c 
will  be  used  as  sorting  guides. 
Array   storing   the   names 
will  be  used  as  sorting  guides 
Array  storing   the  numbers   of 
assign  the  ranking  of  data 
Array  storing   the   names   of 
assign  the  ranking  of  data. 
Array  storing  the  row  mnemonic 
The  number  of  assigned  row  mnem 
The   numbers   of   rows   for  whi 
been  assigned. 

The  invert  relative  addresses  o 
Array  storing  the  mnemonics  of 
Arrays  storing  the   number   of 
starts   suppression   of    rows 
corresponding  on  which  ends  the 
The  number  of  assigned  suppress 
Array  the  numbers  of  rows  used 
the  ranking  of  the  rows. 
The   number   of   row   numbers 
ranking . 


w n  i  c  n  n  ar.es   r. a v  e 


f  COLMNE. 

and   maximum 

f  the  data  is 

ich    tracing 
acing  extreme 

f  RM I N ,  RMAX . 

olumns   which 

columns  which 

columns  that 

columns   that 

names . 

on  i  c  names . 

ch   names  have 

f  ROWMNE . 

sets  of  rows. 

row  on  which 
and     the 

suppress  ion . 
ions  . 
as  guides  for 

used   for  row 


********************************************************* 


IMPLICIT  INTEGER*2  (I-N) 

INTEGER* 2  SN,FLAG1(6) , FLAG2 ( 4 ) ,A(128),B(128) , NKEY ( 123) 

1  NRANK  (128)  ,SUP1(128)  ,SUP2(  128)  ,  xNCO  (  12  8)  , 

2  NRO (12  8), NTR ( 1 2  8 )  , NC I N ( 1 2  8 )  , NT  I N ( 1 2  8 )  , 

3  NRIN( 20  48 ) , NOROW ( 2  0  48) 
CHARACTER* 2 4  COLMNE ( 128 ) , MNE ( 128) , MRANK ( 128 ) , 
1  ROWMNE 1( 2048 ) , ROWMNE 2 ( 128) 
REAL*4  RMINQ28)  , RMAX (  128) 

READ ( LOGN ,200)  NCOL , NRCW , NC , NR , I J , NT , KMN , NNU , NN , NM, SN, 

1  NBROW 

READ( LOGN, 100)  ( FLAG1 ( I )  ,  I  =  1 ,  6  ) 

IF  (FLAGl(l) . EQ. 1)  THEN 

READ ( LOGN ,300)  ( COLMNE ( I )  ,  I  - 1 , NC ) 

READ ( LOGN ,10  0)  ( NCO ( I ) , I = 1 , NC ) 

READ ( LOGN ,10  0)  ( NC I N ( I ) , I = 1 , NC ) 
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100 
200 
300 
400 


END  IF 

IF  (FLAGK2  )  . 
READ(LOGN, 
READ(LCGN, 
READ(LOGN, 
READ (LOGN, 

END    IF 

READ (LOGN, 100 

IF  (FLAG2Q)  . 
READ (LOGN, 
READ (LOGN, 
READ (LOGN, 

END  IF 

IF  (FLAG2(2) . 
READ ( LOGN , 
READ (LOGN, 
READ ( LOGN , 

END  IF 

IF  (FLAGK3). 
READ (LOGN, 

END  IF 

IF  (FLAGK4)  . 
READ (LOGN, 

END  IF 

IF  (FLAGK  5)  . 
READ (LOGN, 

END  IF 

IF  (FLAGK6)  . 
READ (LOGN, 

END  IF 

IF  (FLAG2( 3) . 
READ ( LOGN , 
READ (LOGN, 

END  IF 

IF  (FLAG2U)  . 
READ (LOGN, 

END  IF 


EQ.l)  THEN 

400)  (RMIN( I) , 1=1, NT) 
4  0  0)  ( RMAX ( I ) , I = 1 , NT ) 
100)  (NTR(I) , 1=1, NT) 
10  0)  (  NT  I N  (  I  )  ,  I  =  1 ,  NT ) 

)  (FLAG2( I )  ,  1  =  1,4) 

EQ.l)  THEN 

300)  (ROWMNEl(I) , 1=1, NR) 

10  0)  ( NRO ( I ) , I = 1 , NR ) 
100)  (NRIN( I ) , I=1,NR) 

EQ.l)  THEN 

30  0)  (ROWMNE2( I ) , 1=1, IJ) 
100)  (A(I),I=1,IJ) 
100)  (B( I) , 1=1, IJ) 

EQ.l)  THEN 

100)  (NKEY(I) ,I=1,NN) 

EQ.l)  THEN 

3  0  0)  ( MNE ( I ) , I = 1 , NM ) 

EQ . 1 )  THEN 

10  0)  ( NRANK ( I ) , I = 1 , NNU ) 

EQ.l)  THEN 

3  0  0)  ( MRANK ( I ) , I = 1 , KMN ) 

EQ . 1 )  THEN 

100)  (SUPK  I  )  ,  1  =  1, SN) 

100)  (SUP2( I ) , 1=1, SN) 

EQ.l)  THEN 

10  0)  (NOROW( I ) , I=l,NBROW) 


FORMAT 
FORMAT 
FORMAT 
FORMAT 
RETURN 
END 


15) 
1215) 
X,A24) 
F14.6) 


C 


************************************************************* 


LEC, IMP, FLAG 1 , NCOL , COLMNE , NC , NCO , NC I N , 
RM I N , RMAX , NT , NTR , NT  I N , NKEY , MNE , NN , NM , 
NRANK , MRANK , NNU , KMN ) 


SUBROUTINE  CDISP 
1 

2 

q************************************************************* 

C     This   subroutine  is  used   to   display   on  the  screen  the 

C     column  informations  of  the  header. 

C 
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c 

ARGUMENTS: 

c 

c 

c 

LEC        : 

c 

c 

IMP        : 

c 

c 

FLAG1      : 

c 

c 

c 

NCOL       : 

c 

COLMNE     : 

c 

NC         : 

c 

NCO        : 

c 

c 

NCIN       : 

c 

RM IN, RMAX  : 

c 

c 

c 

NT         : 

c 

c 

_  NTR        : 

c 

c 

NT  IN       : 

c 

NKEY       : 

c 

c 

MNE        : 

c 

c 

NN         : 

c 

c 

NM         : 

c 

c 

NRANK      : 

c 

c 

MRANK      : 

c 

c 

NNU        : 

c 

KMN        : 

£**************** 

of 

a 

of 

whi 


The  logicalunit  number  for  writi 

terminal . 

The  logical  unit  number  for  read 

terminal . 

Integer   array  of  six  elements 

to   indicate   the   existence  or 

several  informations  regarding  t 

The  number  of  columns. 

Array  storing  the  column  mnemoni 

The  number  of  assigned  column  mn 

The   numbers  of  columns  for  whic 

been  assigned. 

The  invert  relative  addresses 

Arrays  storing   the   minimum 

values  between  which   tracing 

going  to  take  place. 

The   number  of  columns   for 

extrema  have  been  assigned. 

The  column  numbers  for  which 
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The  invert  relative  addresses  of 

Array  storing  the   numbers   of  c 

will  be  used  as  sorting  guides. 

Array   storing   the   names   of  c 

will  be  used  as  sorting  guides. 

The   number   of   repeated  sortin 

column  numbers. 

The   number   of  repeated   sortin 

column  mnemonic  names. 

Array   storing  the   numbers 

assign  the  ranking  of  data 

Array   storing   the   names 

assign  the  ranking  of  data. 

The  number  of  columns  used  for  r 

The  number  of  column  names  used 
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IMPLICIT  INTEGER*2  (I-N) 

INTEGER* 2  LEC, IMP, LOGN , NCOL , NROW , NN , NM , NNU , XMN , I J , 

1  NTR( 128) ,FLAG2(4) , NKEY ( 128) , NRANK ( 128 ) ,A( 123) , 

2  B ( 1 2 8 )  , NCO ( 1 2  8 )  , NC I N ( 1 2  8 )  , NT  I N ( 1 2  3 )  , FLAG 1(6) 
REALM  RMIN(  128)  ,  RMAX  (  128) 

CHARACTER* 1  IND 

CHARACTER* 2 4  FNAME , COLMNE ( 128)  , MNE ( 128)  , MRANK I  123 ) 

WRITE( IMP, 100) 
WRITE ( IMP ,200)  NCOL 
IF  (FLAGK  1)  .EQ.l)  THEN 
WRITE ( IMP, 3  00) 
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DO  I=1,NC 

WRITE( IMP, 400 )  NCO( I ) , COLMNE ( NCIN( I ) ) 

END  DO 
END  IF 
IF  (FLAGK  2)  .EQ.l)  THEN 

WRITE( IMP, 500 ) 

DO  I = 1 , NT 

WRITE(  IMP, 600 )  NTR(  I )  ,RMIN(NTIN(  I )  )  , RMAX ( NT  I N (  I  )  ) 

END  DO 
END  IF 
IF  (FLAGK  3)  .EQ.l)  THEN 

WRITE( IMP, 700) 

DO  I=1,NN 

WRITE(  IMP, 800)  xNKEY(I) 

END  DO 
END  IF 
IF  (FLAGK  4)  .  EQ.  1)  THEN 

WRITE( IMP, 900) 

DO  I=1,NM 

WRITE ( IMP, 1000)  MNE(I) 

END  DO 
END  IF 
IF  (FLAGK  5)  .EQ.  1)  THEN 

WRITE( IMP, 1100) 

DO  I=1,NNU 

WRITE ( IMP, 1200)  NRANK(I) 

END  DO 
END  IF 
IF  (FLAGK  6)  .EQ.  1)  THEN 

WRITE( IMP, 1300) 

DO  I=1,KMN 

WRITE ( IMP, 1400)  MRANK(I) 

END  DO 
END  IF 

READ(LEC, 1500)  IND 
IF  ( IND.EQ. '   ' )  THEN 

WRITE( IMP, 1600) 

RETURN 
END    IF 
100  FORMAT( 20(/) , 18X, 'C    OLUMN  INFORMATIONS 

1  /    18X    '*************************************' 

200      FORMAT(//27X, 'NUMBER  OF  COLUMNS ' /27X , 

I  < V/31X,I5) 

300  FORMAK//27X,  'COLUMN    MNEMONICS  ' /27X  , 

1  < V23X, 

2  'Column  number ', 3X ,' Mnemon i c ' /2 3X , 

3 -) 

400      FORMAT(27X, 13, 11X,A24) 
500      FORMAT (//2  8X, 'TRACING  EXTREMA ' /28X , 
.   1     •         ' V13X, 

2  'Column  number' ,6X, 'Minimum' ,9X, 'Maximum' ,/13X, 

3 ) 
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60  0      FORMAT (16X, I 3 , 6X, F14 . 6 , 3X, F14 . 6 ) 

700      FORMAT (//18X, 'COLUMN  NUMBER  GUIDES  FOR  MULTIPLE  SORT'/ 
2         18X,  ' '  ) 

800      FORMAT( 33X, 13) 

900      FORMAT(//17X,  'COLUMN  NAME  GUIDES  FOR  MULTIPLE  SORTV17X, 
I  < ■) 

10  00     FORMAT (4 IX, A2 4 ) 

1100     FORMAT(/2  2X, 'COLUMN  NUMBERS  FOR  RANKING ' /22X, 
I  < .  ) 

1200     FORMAT ( 3 3X, 13) 

1300     FORMAT (/2  3X, 'COLUMN  NAMES  FOR  RANKING ' /23X, 
I ) 

14  0  0     FORMAT ( 3  4X,A2  4) 
150  0     FORMAT (A) 
160  0     FORMAT ( 20 (/) ) 
END 


C 


SUBROUT I NE  RD I SP ( LEC , IMP , FLAG2 , NROW , ROWMNE 1 , NR , NRO , NR I N , 
1  ROWMNE2, I J, A, B, SUP 1, SUP 2 , SN , NORCW , N3RCW ) 


£*************************** 
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*********************************************************** 


IMPLICIT  INTEGER*2  (I-N) 

INTEGER* 2  LEC , IMP , LOGN , NCOL , NROW , NN , NM , NNU , KMN , IJ,SN, 

1  FLAGK6)  ,FLAG2(4)  ,  NKEY  (  128  )  ,  NRANK  (128)  ,A(128 

2  B(128) ,NOROW(2048) ,SUP1( 128) ,SUP2( 128) , 

3  NROQ28)  ,NRIN(2048) 
REAL*4  RMIN( 128) , RMAX ( 128) 
CHARACTER* 1  I ND 

CHARACTER*  2  4  FNAME , COLMNE (12  8), MNE (128), MRANK (128)  , 
1  ROWMNEK  2048)  , ROWMNE2  (  128  ),  NAME 


WRITE( IMP, 100) 

WRITE( IMP, 200)  NROW 

IF  (FLAG2( 1) .EQ.l)  THEN 

WRITE( IMP, 300) 

DO  I = 1 , NR 

WRITE( IMP, 400)  NR0(l 

END  DO 
END  IF 
IF  (FLAG2( 2) . EQ . 1)  THEN 


,R0WMNE1 (NRIN( I 
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WRITE( IMP, 500) 
DO    1=1, I J 

WRITE ( IMP, 600 )  I ,ROWMNE2( I ) 
DO  J=A( I ) ,3( I ) 
NAME= '  ' 
K=l 

DO  WHI LE ( K . LE . NR . AND . NAME . EQ . '   ' ) 
IF  ( J.EQ.NRO(K) )  THEN 

NAME=ROWMNEl(K) 
END  IF 
K=K+1 
END  DO 

WRITE( IMP, 610)  J, NAME 
END  DO 

IF  (I.LT.IJ)  THEN 
WRITE( IMP, 620) 
END  IF 
END  DO 
END  IF 

IF  (FLAG2(3) . EQ . 1 )  THEN 
WRITE( IMP, 700) 
DO  1=1 ,SN 

IF  (SUPl(I) .NE.0.AND.SUP2( I) .NE.0)  THEN 

WRITE ( IMP, 8  00)  I ,SUP1( I ) ,SUP2( I ) 
END  IF 
END  DO 
END  IF 

IF  (FLAG2 (4) . EQ . 1)  THEN 
WRITE( IMP, 1100) 
DO  I=l,NBROW 

WRITE( IMP, 1200)  NOROW(I) 
END  DO 
END  IF 

READ(LEC,90  0)  IND 
IF  ( IND.EQ. '  ' )  THEN 
WRITE( IMP, 1000) 
RETURN 
END  IF 
100      FORMAT ( 2  0 (/), 2 OX, * R  O  W    INFORMATIONS' 
1  /20X  '*******************************') 

200      FORMAT (// 2 9X, 'NUMBER  OF  ROWS' /29X, 

I  < V/32X,I5) 

300  FORMAT (//3 OX, "ROW    MNEMONICS ' /30X , 

1  ' V/23X, 

2  'Row  number ', 6X ,' Mnemonics ' /23X , 

3 -) 

400      FORMAT(25X, 15, 11X,A24) 

500      FORMAT (//20X, 'SETS  OF  ROWS  WITH  COMMON  MNEMONICS ' /20X , 
!  . '//2  0X, 

2  'Set '  ,7X,  'Set '  ,7X,  'Row'  , 7X,  ' Row'  , 7X/19X,  'Number'  , 

3  3X ,  ' mnemon  ic ' 3X ,  ' number '  , 3X ,  ' mnemon  ic ' /19X , 

4 •) 
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600 
610 
620 
700 


800 

900 

1000 

1100 

1200 


FORMAT ( 17X, 15, 7X, A2  4) 
FORMAT ( 3  6X, I5,7X, A2  4 ) 
FORMAT  (19X,  ' ') 

FORMAT  (// 3  OX,  'SUPPRESSIONS'  /30X,  ' V/20X, 

1  ' Suppress  ion ' , 

2  3X,"' From  row',3X,'To  row'/2QX, 

3 ) 

FORMAT (19X, I  5 , 3X , I  5 , 5X ,  I  5 ) 

FORMAT (A) 

FORMAT ( 2  0 ( / ) ) 

FORMAT (// 3 OX,  'ROW  RANKING ' /30X ,  ' '  ) 

FORMAT ( 3 2X, 15) 
END 


•********************************x************-^******x-*rx*Jc*xx* 


^  r 


SUBROUT INE  COLMOD ( LEC , IMP , FLAG1 , NCOL , NROW , COLMNE , NC , NC 

1  NC I N , RM I N , RMAX , NT , NTR , NT  I N , NKEY , MNE , NN , 

2  NM , NRANK , MRANK , NNU , KMN ) 


C******xxxxxxxxxxxxxxxx***xx 
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************************************************************* 


IMPLICIT  INTEGER*2  (I-N) 

INTEGER* 2  LEC , IMP , LOGN , NCOL , NROW , NN , NM , NNU , KMN , IJ, 

1  FLAGK6)  ,NTR(128)  , FLAG2(4)  ,NKEY(  128  )  , 

2  NRANK (128),A(123),B(128), NCO ( 1 2  8 ) , NC I N ( 1 2  8 ) , 

3  NT  I N ( 1 2  8 ) 

REAL*4  RMINQ28)  , RMAX (  128)  ,  RMIND(  128)  ,  RMAXD  (  128) 

CHARACTER* 1  IND 

CHARACTER* 7  MODCOL 

CHARACTER*  2  4  FNAME , COLMNE (12  8), MNE (128), MRANK (123)  , NAME , 

1  ROWMNEK  20  48 )  ,ROWMNE2( 128 )  , COLMNEDf  123 )  , 

DATA  MODCOL/' columns' / 

IDUM=1 

DO  WHILE  ( IDUM.EQ. 1) 
IDUM=0 

WRITE( IMP, 100) 
READ (LEC, 200)  IND 
IF  ( IND.EQ. ' 1' )  THEN 

Column  number  modification 

WRITE( IMP, 300)  NCOL 
READ (LEC, 310)  NCOL 
IDUM=1 

ELSE  IF  (IND!EQ.'2!)  THEN 
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C     Column  mnemonic  names  modification 

IF  (FLAGK  1)  .EQ.l)  THEN 
1  =  1 

DO  WHILE ( I .NE.O) 
WRITE( IMP, 500) 
READ(LEC,400)  I 
IF  (I. NE.O) THEN 
J=l 
DO  WHILE(NCO(J) . NE . I . AND . J . LE . NC ) 

J=J  +  1 
END  DO 

IF  (J-l.EQ.NC.AND.NCO(J) .NE. I)  THEN- 
DO  K=1,NC 

COLMNED  (  K  )  =COLMNE  (  NC  IN  ( K )  ). 
END  DO 
DO  K=1,NC 

COLMNE ( K ) = COLMNED ( K ) 
END  DO 
NC=NC+1 
NCO ( NC ) = I 

WRITE ( IMP, 600)  COLMNE (NC) 
READ(LEC,700)  COLMNE (NC) 
CALL  EXSHl(x^CO,NCIN,NC,  1  ) 
ELSE 

WRITE( IMP, 60  0)  COLMNE (NC IN ( J) ) 
READ(LEC,70  0)  COLMNE (NC I N ( J ) ) 
END  IF 
END  IF 
END  DO 
IDUM=1 
ELSE 

WRITE( IMP, 800) 

CALL  COLNAM ( LEC , IMP , FLAG1 , NCOL , COLMNE , NC , NCO , 
1  NC I N ) 

END  IF 
ELSE  IF  (IND.EQ.'3')  THEN 

C     Tracing  extrema  modification 

IF  (FLAGK  2)  .EQ.l)  THEN 

1  =  1 

DO  WHILE  ( I .NE.O ) 
WRITE( IMP, 500) 
READ(LEC,400)  I 
IF  (I. NE.O)  THEN 
J  =  l 
DO  WH I LE ( NTR ( J ) . NE . I . AND . J . LE . NT ) 

J=J+1 
END  DO 

IF  (J-l.EQ.NT.AND.NTR(J) .NE. I )  THEN 
DO  K=1,NT 
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RM I ND ( K ) =RMIN( NT IN( K ) ) 
RMAXD ( K ) = RMAX ( NT  I N ( K ) ) 
END  DO 
DC  K=1,NT 

RMIN(K)=RMIND(K) 
RMAX(K)  =  RMAXD  (-K) 
END  DO 
NT=NT+1 
NTR(NT)=I 

WRITE ( IMP, 90  0 )  RMIN(NT) 
READ (LEC, 1700)  RMIN(NT) 
WRITE( IMP, 1300)  RMAX(NT) 
READ ( LEC ,17  0  0)  RMAX ( NT ) 
CALL  EXSK1(NTR,NTIN,NT, 1) 
ELSE 

WRITE( IMP, 900 )  RMIN(NTIN( J) ) 
READ( LEC, 17  00)  RMI N ( NT IN( J ) ) 
WRITE( IMP, 1800 )  RMAX(NTIM( J ) ) 
READ( LEC, 1700)  RMAX ( NT  IN ( J )  ) 
END  IF 
END  IF 
END  DO 
IDUM=1 
ELSE 

WRITE ( IMP, 100  0) 

CALL  EXTREM ( LEC , I MP , FLAG 1 , NCOL , NROW , RM I N , RMAX , 
1  NT,NTR) 

END  IF 
ELSE  IF  (IND.EQ.'4')  THEN 

Sorting  guides  modification 

IF  (FLAGK  3)  .EQ.  1)  THEN 

Sorting  guides  by  column  number  modification 

WRITE( IMP, 1100) 

WRITE(LEC,400)  ( NKEY ( I ) , I = 1 , NN ) 

CALL  ANAD I S ( LEC , IMP , NCOL , NCOL , NKEY , NN , MODCOL ) 

CALL  REARM LEC, IMP , NCOL , NROW , NKEY , NN ) 
ELSE  IF  (FLAGM4)  .EQ.l)  THEN 

WRITE ( IMP, 1100) 

DO  I  =  1 , NM 

WRITE( LEC, 13  00)  MNE ( I ) 

END  DO 

WRITE ( IMP, 1400 ) 

CALL  ASBYMN(LEC,  I  MP , NCOL , COLMNE , NM , MNE ) 

CALL  REAR2 ( LEC , IMP , NCOL , NROW , COLMNE , MNE , NM ) 
ELSE 

WRITE( IMP, 1500 ) 

CALL  MULSOR( LEC ,  IMP , NCOL , FLAG  I , NRANK , MRANK , NNU , 

1  'KMN, COLMNE) 
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END  I  F 
IDUM=1 
ELSE  IF  (IND.EQ.'S')  THEN 

Ranking  modification 


IF  (FLAGK5)  .  EQ.l)  THEN 
WRITE( IMP, 1900) 

WRITE(LEC,400)  (NRANK( I ) , 1=1, NNU) 

CALL  ANAD I S ( LEC , IMP , NCOL , NCOL , NRANK , NNU , MCDCOL ) 
CALL  RANK1 ( LEC , IMP , NCOL , NROW , NRANK , NNU ) 
ELSE  IF  (FLAGK6)  .EQ.l)  THEN 
WRITE( IMP, 1900) 
DO  I=1,KMN 

WRITE( IMP, 1300)  MRANK(I) 
END  DO 

WRITE( IMP, 2000) 

CALL  AS3YMN(LEC, IMP , NCOL , COLMNE , KMN , MRANK ) 
CALL  RANK2 ( LEC , I MP , NCOL , NROW , MRANK , KMN , COLMNE ) 
ELSE 

WRITE( IMP, 2200) 

CALL  CRANK (LEC, IMP , NCOL , NROW , FLAG1 , NRANK , MRANK , 
1  NNU , KMN , COLMNE ) 

END  IF 
ELSE  IF  (IND.EQ.'   ' )  THEN 

RETURN 
END  IF 
END  DO 
RETURN 
100      FORMAT (///8X, 'MODIFICATION  SELECTION  TABLE' /8X, 

1  < -'/9X, 

2  'Number  of  columns 

3  'Mnemonic  names 

4  'Tracing  extrema 

5  'Sorting  guides 

6  'Rank  of  columns 

7  ' Answer  : ' ) 
200      FORMAT (A) 
300      FORMAT (///,4X, 'Old  number  of  columns 

1  'Assign  new  number 

310      F0RMAT(I3) 

400      FORMAT(/4X,100(20( 13,  ',')/)  ) 
500      FORMAT (/,'$' ,3X, 'Assign  column  number  :') 
600      FORMAT(///4X, 'Old  name         : * , A24/ ' $ ' , 3X , 

1        'Assign  new  name  : ' ) 
700      FORMAT (A2 4) 

800      FORMAT (///4X, 'MNEMONIC  NAMES  HAVE  NOT  BEEN  ASSIGNED!!') 
900      FORMAT(///4X, 'Old  MIN  : ' , F14 . 6/ ' $ ' , 3X , 

1        ' Ass  ign  new  MIN  :  '  ) 
1000     FORMAT (///4X, 'TRACING  EXTREMA  HAVE  NOT  BEEN  ASSIGNED!!' 
1100     FORMAT(///4X, 'Old  sorting  guides     :') 
1200     FORMAT(///4X, 'Assign  column  numbers  :') 


1V9X, 
2V9X, 
3V9X, 
4V9X, 
5'//' $ 


' ,I3,/'S 
'  ) 


3X, 


3X, 
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1300 
1400 
1500 
1600 


1700 
1800 

1900 
2000 
2200 


FORMAT 

FORMAT 

FORMAT 

FORMAT 

1 

2 

FORMAT 

FORMAT 

1 

FORMAT 

FORMAT 

FORMAT 

END 


/2X,A 
///4X 
///4X 
///4X 
'  ASS 

'Ass 
F14.6 
///4X 

'Ass 
///4X 
4X 
4X 


24) 

, 'Assign  mnemonic  names  : ' ) 

, 'SORTING  GUIDES  DC  NOT  EXIST!!') 

, 'THE  ASSIGNED  MNEMCNI CHAS  NOT  3EEN'/6X, 

IGNED  AS  COLUMN  MNEMONIC !!' //4X, 

ign  next  mnemonic') 


:  '  ,F14.6, 


'  ,3X, 


, 'Old  MAX 
ign  new  MAX  : ' ) 
,  'Old  ranking  :  '  ) 
, 'Assign  new  ranking  guides  : ' ) 
'RANKING  HAS  NOT  BEEN  ASSIGNED!! 


SUBROUTINE  ROWMOD(LEC, IMP, FLAG 2 , NCOL , NROW , ROWMNE 1 , NR , 

1  NRO,NRIN,ROWMNE2 , I J , A , 3 , SUP1 , SU?2 ,SN, 

2  NOROW,NBROW) 
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c 

star 

c 

corr 

c 

SN 

:  The 

c 

NOROW 

:  Arra 

c 

the 

c 

NBROW 

:  The 

c 

rank 

c 

£*xxxxxxxxxxxxxx- 

t  X  X  X  X  X 

logical  uni 
.inal . 

logical  uni 
.inal . 

correspondi 
number  of  c 
number  of  r 
iy  storing  t 
number  of  a 
numbers  of 

ass  igned . 
invert  rela 
lv  storing  t 
number  of  a 
.ys  storing 
ts   a   set 
■esponding  o 
^ys   storing 
ts    suppre 
■esponding  o 
number  of  a 
.y  the  numbe 
ranking  of 

number   of 
ing 


t  number  for  writing   on   the 

t  number  for  reading  from  the 

ng  flag  for  rows. 

olumns . 

ows  . 

he  row  mnemonic  names. 

ssigned  row  mnemonic  names. 

rows  for   which    names   have 


1 1  ve 
he  m 
ss  ig 
the 
of 
n  wh 

th 
ss  io 
n  wh 
ss  ig 
rs  o 
the 

ro 


addres 
nemon  ic 
ned  tra 
mumbe 
common 
ich  end 
e  numbe 
n   of 
ich  end 
ned  sup 
f  rows 
rows . 
w   numb 


ses  of 

s  of  s 
c  ing  e 
r  of 
name 
s  the 
r  of 

rows 
s  the 
press  i 
used  a 


ROWMNE 
e 1 3  of 
xt  rema 
row  on 
rows  an 
set  . 
row  on 
and 
suppres 
ons  . 
s  guide 


row- 
set 
wh  i 
d  t 

whi 

t 

s  io 


s  . 
s  . 
ch 

he 

ch 
he 
n  . 


ers   used 


:or 


row 


xxxxxxxxxxxxxxxxxx 


IMPLICIT  INTEGER*2  (I-N) 
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INTEGER* 2  FLAG2U)  ,  A  (  1  2 3  )  ,  3  (  I  2 8  )  ,SUP1(I23)  ,SU?2(  128)  , 
1  NRO ( 1 2  8 )  , MR  I N ( 2  C  4  3 )  , SN , NCRCW ( 2  0  4  3 ) 

CHARACTER* 1  IND 
CHARACTER* 7  MODROW 
CHARACTER*  2 4  ROWMNEK20  43 
DATA  MODROW/' rows' / 


ROWMNE 2(123) , ROWMNE 10(128 


IDUM=1 

DO  WHILE  ( IDUM.EQ. 1) 
IDUM=0 

WRITE( IMP, 100) 
READ(LEC,200)  IND 
IF  ( IND.EQ. ' 1' )  THEN 
WRITE ( IMP, 300)  NROW 
READ(LEC,40  0)  NROW 
IDUM=1 
ELSE  IF  (IND.EQ. '2')  THEN 
IF  (FLAG2( 1) .  EQ. 1)  THEN 
1  =  1 

DO  WHILE  ( I .NE.0) 
WRITE( IMP, 500) 
READ(LEC,400)  I 
IF  ( I . NE . 0 )  THEN 
J  =  l 
DO  WH I  LE  (  NRO  (  J  )  .  NE  .  I  .  AND  .  J  .  LE  .  NR ) 

J=J+1 
END  DO 

IF  ( J-l.EQ.NR.AND.NRO(J) . NE . I )  THEN 
DO  K=1,NR 

ROWMNE 1 D ( K ) = ROWMNE 1 ( NR I N ( K ) ) 
END  DO 
DO  K=1,NR 

ROWMNE 1 ( K ) =ROWMNElD ( K ) 
END  DO 
NR=NR+1 
NRO ( NR ) = I 

WRITE ( IMP, 60  0)  ROWMNEl(NR) 
READ(LEC, 700)  ROWMNEl(NR) 
CALL  EXSHl(NRO,NRIN,NR, 1) 
ELSE 

WRITE ( IMP, 600)  ROWMNEl(NRIN( J) ) 
READ(LEC,700)  ROWMNE 1 ( NRI N ( J ) ) 
END  IF 
END  IF 
END  DO 
IDUM=1 
ELSE 

WRITE( IMP, 800) 

CALL  ROWNAM(LEC, IMP, FLAG2 , NROW , ROWMNE 1 , NR , NRO , 
1  NR IN, ROWMNE 2 , IJ, A,B) 

END  IF 
ELSE  IF  (IND.EQ." 3')  THEN 


14  8 


IF  (FLAG2( 2) .EQ. 1)  THEN 
WRITE( IMP, 900) 
READ (LEC, 200)  IND 
IF  ( IND.EQ. ' K  )  THEN 
1  =  1 

DO  WHILE( I .NE.O ) 
WRITE ( IMP, 1000) 
READ(LEC,4  00)  I 
IF  ( I . NE . 0 )  THEN 

WRITE ( IMP, 1100)  I,A(I),3(I) 
READ(LEC,40  0)  A(I) 
WRITE( IMP, 1200) 
READ(LEC,400)  B(I) 
END  IF 
END  DO 
ELSE  IF  (IND.EQ. '2')  THEN 
1  =  1 

DO  WHILE( I .NE.O) 
WRITE( IMP, 1100) 
READ(LEC,40  0)  I 
IF  ( I . NE . 0 )  THEN 

WRITE ( IMP, 1400)  ROWMNE2(I) 
READ (LEC, 700)  ROWMNE2 ( I ) 
END  IF 
END  DO 
IDUM=1 
ELSE 

WRITE( IMP, 1500) 
IDUM=1 
END  IF 
ELSE 

WRITE( IMP, 800) 

CALL  ROWNAM(LEC, IMP,FLAG2 , NROW , ROWMNE1 ,RCWMNE2 , 
1  IJ,A,3) 

END  IF 

ELSE  IF  (IND.EQ.* 4')  THEN 
IF  (FLAG2(3) . EQ . 1 )  THEN 
1  =  1 

DO  WHILE  ( I .NE.O) 
WRITE( IMP, 1600) 
READ(LEC,400)  I 
IF  (I. NE.O)  THEN 

IF  (SUPK I ) .EQ.0.AND.SUP2( I ) .  EQ .  0 )  THEN 
SN=SN+1 

WRITE( IMP, 1700 )  SUPK I ) ,SUP2( I ) 
READ(LEC,400)  SUPl(I) 
WRITE( IMP, 1800 ) 
READ(LEC,400)  SUP2( I ) 
ELSE  IF  (SUPK I ) .NE.O .AND. SUP 2 ( I ) .NE.O) 
1      THEN 

WRITE ( IMP, 17  00 )  I  ,SUPK I )  ,SUP2 (  I )  ,  I 
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READ (LEC, 400)  SUP1(I) 

WRITE ( IMP, 1300 ) 
READ(LEC,400)  SUP2(I) 
IF  (SUPK I ) .EQ.O . AND. SUP 2 ( I) .EQ.O) 
1  THEN 

NROW=NROW+l 
END  IF 
END  IF 
END  IF 
END  DO 

CALL  SUPSET(LEC, IMP , NCOL , NROW , SUP  1 , SUP 2 ,  SN) 
IDUM=1 
ELSE 

WRITE( IMP, 1900) 

CALL  ROWSUP(LEC, IMP , FLAG 2 , NRCW , SUP1 ,SUP2 , SN 
END  IF 
ELSE  IF  (IND.EQ.'5')  THEN 
IF  (FLAG2(4) . EQ . 1 )  THEN 
WRITE( IMP, 2000) 

WRITE( LEC, 2100)  (NOROW( I ) , I=1,NBRCW) 
CALL  ANADIS(LEC, IMP , NROW , NROW , NOROW , N3R0W , 
1  MODROW) 

CALL  REORD ( LEC , IMP , NCOL , NROW , FLAG 2 , NOROW , 
1  NBROW) 

IDUM=1 
ELSE 

WRITE( IMP, 2200) 

CALL  ANADIS(LEC, IMP , NROW , NROW , NOROW , NBROW , 
1  MODROW) 

CALL  REORD ( LEC , IMP , NCOL , NROW , FLAG 2 , NOROW , 
1  NBROW) 

END  IF 
ELSE  IF  (IND.EQ.'   ')  THEN 

RETURN 
ELSE 

WRITE( IMP, 1500) 
IDUM=1 
END  IF 
END  DO 

100      FORMAT(  10(/)  ,4X,  'MODIFICATION  SELECTION  TABLEV4X, 

1 ./4X| 

2  'Number  of  rows 

3  'Mnemonics  by  row 

4  'Mnemonics  by  series  of  rows 

5  'Suppression 

6  ' Rank  of  rows 

7  /'$• ,3X, 'Answer 
200      FORMAT (A) 
300      FORMAT(///4X,  'Old  number  of  rows  :  '  , I  5/ ' $ '  , 3X , 

1  'Assign  new  number   : ' ) 

400      F0RMAT(I5) 
500      FORMAT (///'$* ,3X, 'Assign  column  number  :') 
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1V4X, 
2V4X, 

3V4X, 
4V4X, 
5' 


600 

700 
800 
900 


1000 

1100 


1200 
1400 

1500 
1600 
1700 


1800 
1900 
2000 
2100 
2200 


FORMAT ( 
1 

FORMAT ( 

FORMAT ( 

FORMAT ( 

1 

2 

FORMAT ( 

FORMAT ( 

1 

2 

3 

4 

FORMAT ( 

FORMAT ( 

1 

FORMAT ( 

FORMAT ( 

FORMAT ( 

1 

2 

3 

4 

FORMAT ( 

FORMAT ( 

FORMAT ( 

FORMAT ( 

FORMAT ( 

RETURN 

END 


/// 
'A 
A24 
/// 
/// 


4X, 'Old  name 

ss  ign  new  name  :  '  ) 


: ' ,A24/'$* ,3X, 


3X,  ' 

4X,  ' 


///4X, 


/// 

/// 
/// 
/// 


MNEMONIC  NAMES  DO  NOT  EXIST 

Serie  modification   :1'/4X, 

Name  modification 

Answer 

3X,'Assign  serie  number 


2'/'$'  ,3X, 


,3X, 

4X, 

5X,  ' 

4X, 


,  I5/4X, 

,  I5/4X, 

,I5//4X, 

/'$' ,3X, 

) 

) 

,X,A24/' $' ,3X, 


'$' 


/4X 
/// 


,3X, 
4X,  ' 
4X,  ' 
,100 
4X,  ' 


'Old  serie 

' From  row 

' To  row 

'Assign  new  serie 

' From  row 

' To  row 

'Old  mnemonic 

'Assign  new  mnemonic 

INVALID  CHARACTER! !  * ) 

3X, 'Assign  suppression  number 

'Old  suppression 

'From  row 

'To  row 

'Assign  new  suppression 
3X, ' From  row 

'To  row 

NO  SUPPRESSION  HAS  BEEN  ASSINGED! 
Old  ranking  : ' ) 
(20(13,',' )/) ) 
RANKING  HAS  NOT  BEEN  ASSIGNED!!') 


15, /4X 
I5,/4X 
I5//4X 

I  5  ,  /  '  S 


************************************************************** 


C* 

c 
c 
c 
c 

c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c* 


SUBROUTINE  TESTER  ( NCOL , NAME , COLMNE , TEST ) 
************************************************************ 

This  subroutine  is  used  to   test  if  a  mnemonic  name  has 
been  assigned  as  column  mnemonic  name 

ARGUMENTS 


NCOL 
NAME 
COLMNE 

TEST 


The  number  of  columns 

The  mnemonic  to  be  tested. 

Array  storing  the  column  mnemonic  names 

data  will  be  stored. 

Flag   indicating   that   the   tested  name  is   an 

assigned  mnemonic  or  not. 


************************************************************ 


IMPLICIT  INTEGER*2  (I-N) 
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INTEGER* 2  NCOL 

CHARACTER*24  COLMNE(128)  ,  NAME 

LOGICAL*l  TEST 

1  =  1 

TEST=. FALSE. 

DO  WHILE(TEST.EQ.  .FALSE.  .AND.  I  . LE . 128  ) 

IF  (COLMNE( I ) .EQ.NAME)  THEN 
TEST=.TRUE. 

END  IF 

1  =  1  +  1 
END  DO 
RETURN 
END 

SUBROUTINE  REORD(LEC, IMP , NCOL , NROW , FLAG 2 , NOROW, NBROW) 

c 

C      ARGUMENTS 
C      

c 

C  LEC    :  The   logical  unit   number   for   writing   on   the 

C  terminal. 

C  IMP    :  The   logical  unit  number  for   reading   from   the 

C  terminal. 

C  NCOL   :  The  number  of  columns 

C  NROW   :  The  number  of  rows 

C  NOROW  :  Array  the  numbers  of  rows  used  as  guides  for  the 

C  ranking  of  the  rows. 

C  NBROW  :  The  number  of  row  numbers  used  for  row  ranking. 

C 

£******************************^ 

IMPLICIT  INTEGER*2  (I-N) 

INTEGER* 2  AR( 128 ) , N0( 128 ) , NOR (128) ,DUM(128) , FLAG2 ( 4 ) , 

1  NOROW (2048) 

CHARACTER*45  DEVDIR, NAME*10 

REAL*4  X(128) ,Y(128) 

DIMENSION  NOCOL(2  56) 

DATA  DEVDIR, NAME/' DUAO  :','   '/ 
DATA  LOGOLD,LOGNEW/2,2/ 

FLAG2(4)=1 

NBYTES=NCOL*4 

CALL  FICH    (' 069' ,LOGOLD, 1, DEVDIR, NAME, NROW, NBYTES, 1, 

1  'DIRECT' ,  LEC, IMP) 

IF  ( NBROW. NE. NROW)  THEN 

NBYTES=NCOL*4 

LOGNEW=3 

CALL  FICH( ' 069 ' ,LOGNEW, 1 , DEVD I R , NAME , NROW , NBYTES , 0 , 

1  'DIRECT' LEC, IMP) 
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DO  I=1,N3RCW 

READ  ( LOGOLD' NCRCW( I ) )  ( Y ( J ) , J= 1 , NCOL ) 
WRITE(LOGNEW I         )  ( Y( J ) , J=l , NCOL) 
END  DO 
NROW=NBROW 
ELSE 

DO  I=1,N3R0W 

READ  (LOGOLD* I         )  ( X ( J ) , J= 1 , NCOL ) 

READ  (LOGOLD'NOROW( I ) )  ( Y ( J ) , J= 1 , NCOL ) 

WRITE (LOGOLD' I         )  ( Y ( J ) , J= 1 , NCOL ) 

WRITE (LOGOLD'NOROW( I ) )  (X(J) ,J=l,NCOL) 

J=I 

DO  WHILE  (NOROW(J) .  NE . I ) 

J=J  +  1 
END  DO 

NOROW(  J)=xMOROW(  I  ) 
END  DO 
END  IF 

CLOSE (LOGOLD) 
CLOSE (LOGNEW) 
RETURN 
END 


SUBROUTINE  RANK1  ( LEC , IMP , NCOL , NROW , NRANK , NNU ) 

c 

C  Used   to    rearrange   the   columns   of   the   data  matrix 

C  according  the  column  numbers  assigned  by  the  user, 

C 

C  ARGUMENTS : 

C 

C  LEC    :  The  logical   unit   number   for   writing   on   the 

C  terminal. 

C  IMP    :  The   logical   unit   number   for  reading  from  the 

C  terminal . 

C  NCOL   :  The  number  of  columns. 

C  NROW   :  The  number  of  rows. 

C  NRANK  :  Array  storing  the  column  numbers  that   determine 

C  the  reordering  of  the  columns. 

C  NNU    :  The  number  of  columns  that  will  be  ranked. 

C 

q*  ***********************************************************  * 

IMPLICIT  INTEGER*2  ( I-N) 
INTEGER* 2  NRANK (128) 
CHARACTER* 2 4  A(128),B(128) 
CHARACTER*45  DEVDI R, NAME* 10 
REAL* 4  X(128) , Y( 128) 
DATA  DEVDIR,NAME/'DUAO  :','   V 
DATA  LOGOLD , LOGNEW/ 2,2/ 
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C      For  the  'old'  file. 

WRITE ( IMP, 100) 

NBYTES=NCOL*4 

CALL  FICH    (' 0  69' , LOGOLD, 1, DEVOIR, NAME, NRCW , MBYTES , 1, 

1  'DIRECT' ,LEC, IMP) 

C      For  the  eventual  'new'  file. 

IF  (NNU.NE.NCOL)  THEN 
LOGNEW=3 

WRITE( IMP, 200) 

NBYTES=NNU*4 

CALL  FICH(  '069'  , LOGNEW , 1 , DEVOIR, NAME , NRCW, MBYTES , 0  , 
1  'DIRECT' ,LEC, IMP) 

END  IF 

DO  I=l,NROW 

READ  (LOGOLD' I)  ( X ( J ) , J=l , NCOL ) 
WRITE (LOGNEW I )  ( X ( NRANK ( J ) ) , J=1,NNU) 

END  DO 

NCOL=NNU 

CLOSE (LOGOLD) 

CLOSE (LOGNEW) 

RETURN 

100    FORMAT(/' $', 3X, 'Assign  the  ''OLD*'  direct  access  file  : 

1       V4X,37(  '-'  )  ) 
200    FORMAT(/' $', 3X, 'Assign  the  ''NEW'  direct  access  file  : 

1       */4X,37( '-' ) ) 

END 


SUBROUTINE  RANK 2  ( LEC , IMP , NCOL , NROW , MRANK , KMN , COLMNE ) 

c 

C  Used   to   rearrange   the   columns   of   the   data   matrix 

C  according  the   column   mnemonic  names.  It  calls  TRANS  to 

C  transform   the  column  name  to  column  number. 

C 

C  ARGUMENTS  : 

C 

C  LEC    :  The  logical   unit   number   for   writing   on   the 

C  termi  nal . 

C  IMP    :  The   logical   unit   number   for  reading  from  the 

C  terminal. 

C  NCOL   :  The  number  of  columns. 

C  NROW   :  The  number  of  rows. 

C  MRANK  :  Array  storing  the   column   mnemonic   names   that 
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c 
c 
c 
c 
c 


determine  the  reordering  of  the  columns. 
KMN    :  The  number  of  columns  that  will  be  ranked. 
COLMNE:  Array  storing  the  column  mnemonic  names. 

************************************************************* 


IMPLICIT  INTEGER*2  (I-N) 
INTEGER*2  N(128) 
REAL*4  X( 123) ,  Y( 128) 
CHARACTER* 4 5  DEVDI R , NAME* 10 
CHARACTER* 2 4  COLMNE ( 128) , MRANK ( 128 


DATA  DEVDIR,NAME/ ' DUAO 
DATA  LOGOLD/2/ 


f     1  I 


/ 


100 


NBYTES=NCOL*4 

WRITE( IMP, 100) 

CALL  F I CH (  '069'  , LOGOLD , 1 , DEVD I R , NAME , NROW , MBYTES , 1 , 

1  'DIRECT' ,LEC, IMP) 

CALL  TRANS ( MCOL , COLMNE , KMN , MRANK , N ) 

DO  1=1, NROW 

READ( LOGOLD* I )  ( X ( J ) , J=l , NCOL ) 

WRITE (LOGOLD" I )  (X(N(J) ) ,J=1,KMN) 
END  DO 

CLOSE (LOGOLD) 
RETURN 

FORMAT(/' $', 3X, 'Assign  the  ''OLD''  direct  access  file  : 
1       V4X,37(  *-'  )  ) 
END 


£************************************************************* 

SUBROUTINE  REAR1  ( LEC , IMP , NCOL , NROW , NKEY , NN ) 
(2************************************************************* 

C 

C     Used  to   continue  the  process  of  multi-sorting  according 

C      column  numbers  by  calling  the  subroutine  REAR  . 

C 

C      ARGUMENTS  : 

C 

C      LEC 

C 

C      IMP 

C 

C      NCOL 

C      NROW 

C      NKEY 

C 

C      NN 

C 

c 


The  logical   unit   number   for   writing   on   the 

terminal . 

The   logical   unit   number   for  reading  from  the 

terminal . 

The  number  of  columns. 

The  number  of  rows. 

Array  storing  the  column  numbers  used  as  sorting 

column  guides. 

The   number   of   repeating   sortings    according 

column  number. 


************************************************************** 
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IMPLICIT  INTEGER*2  (I-N) 

INTEGER* 2  NKEY(12S) 

DATA  LOGOLD/2/ 

CALL  REAR ( LEC , IMP , NCOL , NROW , NKEY , NN ) 

RETURN 

END 

SUBROUT  I NE  REAR2  (  LEC  ,  IMP  ,  NCOL  ,  NROW  ,  COLMNE  ,  MNE  ,  N"M  ) 

£xxxxxxxxxxxxxxxxxxxxxxx*xxxxxxxx**xxxxx*xxxxxxx^ 

c 

C  It  functions  like   REAR1  for  column  assignment  according 

C  column  names.  It  calls  TRANS  to  transform   column   names 

C  to  colun  numbers. 

C 

C  ARGUMENTS  : 

C 

C  LEC    :  The  logical   unit   number   for   writing   on   the 

C  terminal. 

C  IMP    :  The   logical   unit   number   for  reading  from  the 

C  terminal. 

C  NCOL   :  The  number  of  columns. 

C  NROW   :  The  number  of  rows. 

C  COLMNE:  Array  storing  the  column  mnemonic  names. 

C  MNE    :  Array  storing  the  names  of  columns  which  will  be 

C  used  as  sorting  column  guides. 

C  NM     :  The   number   of    repeating   sortings   according 

C  column  mnemonic  names. 

C 

Qxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 

IMPLICIT  INTEGER*2  (I-N) 

INTEGER*2  N(128) 

CHARACTER* 2 4  COLMNE (12  8), MNE (128) 

DATA  LOGNEW/2/ 

CALL  TRANS ( NCOL , COLMNE , NM , MNE , N ) 

CALL  REAR (LEC, IMP , NCOL , NROW , N , NM ) 

RETURN 

END 


Q*  *  *  *  ie  *********  it  *  *  *  ic  *  ie  ii  *  it  *  *  *  ie  ******  ie  *  *  it  *  *  ir  *  *  it  *  *  ir  *  *  *  it  *  *  ir  it  i(  *  *  ^  *  * 

SUBROUT I NE  REAR ( LEC , I MP , NCOL , NROW , AR , NSORT ) 

Qxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 

c 

C  Used  for  the  multisorting  of  the  data  matrix.   It   opens 

C  the  direct-access  file  of   data,   and   consequenty  calls 

C  the  subroutine  EXTREE  for  the  sorting.  It  rearranges  the 

C  data  according   the   filnal   inverted  relative  addresses 

C  without   using   extra   file  for  temporary  storage  of  the 

C  data. 
C 
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c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 


ARGUMENTS 
LEC 


IMP 

NCOL 
NROW 
AR 

NSORT 


The  logical   unit   number   for   writing   on   the 

terminal . 

The   logical   unit   number   for  reading  from  the 

terminal . 

The  number  of  columns. 

The  number  of  rows. 

Array   storing   the  numbers  of  columns   used   as 

guides  for  the  mult isort ing . 

The  number  of  guides. 


C 

c 
c 
c 

c 


c 
c 
c 
c 


•it*********************************************************-*-)!-* 

IMPLICIT  INTEGER*2  (I-N) 

INTEGER* 2  AR ( 128 ) , NO ( 1 2  8 ) ,  NCR( 12  3) , DUM( 128) 

CHARACTER* 4 5  DEVDI R , NAME* 10 

REAL*4  X(128) ,Y(128 ) 

DATA  DEVDI R, NAME/' DUAO  :','  V 
DATA  LOGOLD/2/ 

NBYTES=NCOL*4 

WRITE! IMP, 100) 

CALL  FICH( ' 069' , LOGOLD, 1 , DEVDI R , NAME , NROW , NBYTES , 1 , 

1  'DIRECT' ,LEC, IMP) 

PART  1  :  Successive   actualization  of  NO( )  according  to  the 
address  calculations  after  each  sort  over. 

For  each  sorting  colum  guide. 
DO  1=1, NROW 

NOR( I )=I 
END  DO 
DO  J =1, NSORT 

DO  1=1, NROW 

For  next  column  guides,  permits  actualization  of  NO( ) 
READ ( LOGOLD ' NOR (I))  ( X ( K ) , K= 1 , NCOL ) 
Y( I )=X(AR(J) ) 

END  DO 

Tree  sort  is  needed  for  multi  sorts,  if  the  data  are 
in  previous  order,  the  user  will  "burst"  them  by  a 
dummy  sort  according  to  any  unsorted  column  to 
restore  the  performances  of  this  method. 

CALL  EXTREE( Y, NO, NROW, 1) 

DO  L=l,NROW 

K=NOR(NO(L) ) 
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c 
c 
c 
c 


DUM(L)=K 
END  DO 
DO  N=l,NROW 

NOR(N)=DUM(N) 
END  DO 
END  DO 

PART  2  :  Rearranging  lines   according  to  last  NO 
extra  storage. 


vi  t nout 


100 


DO  I=l,NROW 

READ ( LOGOLD '  I )  ( X ( J )  , J  =  1 , NCOL ) 

READ (LOGOLD' NOR ( I ) )  (Y( J) , J=l,NCOL) 

WRITE( LOGOLD' I )  ( Y ( J ) , J= 1 , NCOL ) 

WRITE( LOGOLD' NOR ( I ) )  (X(J) ,J=l,NCOL) 

J=I 

DO  WHILE(N0R(J) . NE . I ) 
J=J  +  1 

END  DO 

NOR(J)=NOR( I ) 
END  DO 

CLOSE (LOGOLD) 
RETURN 

FORMAT(/" $', 3X, 'Assign  the  ''OLD''  direct  access  file  : 
1       V4X,37(  '-'  )  ) 
END 


£************************************************************* 
SUBROUTINE  TRANS ( NCOL , COLMNE , Nl , N2 ,N) 

Q* *****************************************************  ******* 

c 

Used  to  transform  column  mnemonic  names  to  corresponding 
column  numbers. 


ARGUMENTS  : 


C 
C 

c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 

£************************************************************* 


NCOL 
COLMNE 
Nl 
N2 

N 


The  number  of  columns. 

Array  storing  the  column  mnemonic  names. 

The  number  of  guides. 

Array   storing   the  column  names  used  as   guides 

for  the  mul t isort ing . 

Array   storing    the    column    numbers     after 

transf ormat  ion . 


IMPLICIT  INTEGER*2  (I-N) 
INTEGER*2  N(128) 

CHARACTER* 2 4  COLMNE ( 1 28 ), N2 ( 128 ) 
LOGICAL*l  TEST 

DO  1=1, Nl 
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DO  J=1,NCCL 

IF  (COLMNE( J) .EQ.N2( I ) )  THEN 
TEST=.TRUE. 

ELSE 

TEST=. FALSE. 
END  IF 
I  F  ( TEST . SQ .  . TRUE .  )  THEN 

N( I )=J 
END  IF 
END  DO 
END  DO 
RETURN 
END 


'***************************************************x********* 

SUBROUTINE  COMROW(LEC, IMP , LOGN, NCOL ,NROW, FLAG 1 , FLAG 2 , 

1  COLMNE , NC , NCO , NC I N , I J , A , 3 , ROWMNE 1 , NR , 

2  NRO , NR I N , ROWMNE  2 , H 1 F  NAME , H 2  FN AME , RM I N , 

3  RMAX , NT , NTR , NT  I N ) 
********************************************************** 


Q*  *  * 

c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 


Used  to  merge  (combine)  two  data  files  and  their  headers 
in  the  row-row  (one  over  the  other)  sense. 


ARGUMENTS 

LEC 

IMP 

LOGN 

NCOL 
NROW 
FLAG1 


FLAG2 
COLMNE 
NC 
NCO 


NCIN 

IJ 

A,B 


ROWMNE 1 

NR 

NRO 

NRIN 


The  logica 
terminal . 
The  logica 
terminal . 
The  logic 
will  be  st 
The  number 
The  number 
Integer  ar 
to  indicat 
several  in 
The  corres 
Array  stor 
The  number 
The  number 
assigned  n 
The  invert 
The  number 
Arrays  sto 
starts  a 
correspond 
Array  stor 
The  number 
The  numbe 
assigned  n 
The  invert 


1  unit  number  for  writing 


on 


-llC 


1  unit  number  for  reading  from  the 


the  file  on 
s  data. 


wn 


used  as   fl 

not   of   t 

the  columns 


al   chanel   for 
ored  the  header 
of  columns. 
of  rows, 
ray  of  six  elements 
e   the  existence   or 
formations  regarding 
ponding  flag  for  rows, 
ing  the  column  mnemonic  names. 

of  assigned  column  mnemonic  nam 
s  of  columns  for  which  have    be 
ames  . 
relative  addresses  for  COLMNE. 
of  assigned  tracing  extrema  set 
ring  the  number   of   row  on   whi 
of  common   name   rows   and  t 
on  which  it  terminates, 
the  row  mnemonic  names, 
assigned  row  mnemonic  names. 
of   rows   for   which  have  be 


set 
ing 
ing 
of 
rs 


ag 

he 


es 
en 


s  . 
ch 

he 


en 


ames  . 
relative  addresses  of  ROWMNE. 
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c 

ROWMNE 2    : 

c 

H1FNAME    : 

c 

c 

H2FNAME    : 

c 

RMIN,RMAX  : 

c 

c 

c 

NT         : 

c 

c 

NTR        : 

c 

c 

NT  I N       : 

c 

rows  . 

wh  ich 


Array  storing  the  mnemonics  of  sets  o 

The   name  of  the  first   header's  file 

will  be  merged. 

The  name  of  the  second  file  for  merging. 

Arrays   storing   the  minimum  and  the  maximum 

values  between   which  tracing  of  the  data  is 

going  to  take  place. 

The  number   of   columns   for   which   tracing 

extrema  have  been  assigned. 

The   column   numbers   for   which   for   which 

tracing  extrema  have  been  assigned. 

The  invert  relative  addresses  for  RMI.RMAX. 


IMPLICIT  INTEGER*2  (I-N) 

INTEGER* 2  FLAG1 ( 6 ) , FLAG2 ( 3) , NCO ( 128) , NRO ( 128),A(128), 

1  B(128) ,AD,BD,NTR(128) ,NCOD( 128) , FLAG12  16) , 

2  FLAG2  2(3), NTRD ( 1 2  8 )  , NT  I N ( 1 2  8 )  , NT  I ND ( 1 2  8 )  , 

3  NRINQ28)  ,NCIN(128)  ,NCIND(128) 

CHARACTER*24  COLMNE( 128 ) , H1FNAME , H2FNAME , COLMNED ( 128 ) , 
1  ROWMNE 1( 128) ,R0WMNE2( 128) , ROWMNE D 

REAL*4  RMIN( 128) , RMAX ( 128) ,RMIND(128) , RMAXD ( 128) ,X( 128) 
CHARACTER* 4 5  DEVDIR, NAME* 10 

DATA  DEVDIR,NAME/"DUAO  :','   V 
DATA  LOGNEW,LOGOLDl,LOGOLD2/3, 1, 2/ 

Open  the  first  header's  file. 

0PEN(UNIT=L0GN,FILE=H1FNAME,STATUS='0LD' ) 
REWIND  LOGN 


Read  the  data  to  be  combined. 

READ(LOGN, 100 )  NCI ,NR1 ,NCA,NRA, IJA,NTA 
READ( LOGN, 200)  ( FLAG1 ( I )  , I  =  1 , 6  ) 


THEN 

COLMNE( I ) , 1=1 ,NCA 
NCOD( I ) , 1=1, NCA) 
NCIN( I ) , 1=1, NCA) 


IF  (FLAGl(l) . EQ. 1 

READ (LOGN, 300) 

READ( LOGN, 200) 

READ( LOGN, 200) 

DO  1=1, NCA 

COLMNED ( I )=COLMNE(NCIN( I ) 

END  DO 
END  IF 
IF  (FLAGK2)  .EQ.  1 

READ( LOGN, 500) 

READ (LOGN, 500) 

READ (LOGN, 20  0) 

READ( LOGN, 2  00) 

DO  1=1, NT A 

RMIND( I)=RMIN(NTIN( I ) ) 


THEN 
(RMIN( I ) , 1=1, NTA) 
( RMAX ( I ) , I = 1 , NTA ) 
(NTRD( I ) , 1=1 ,NTA) 
(NTIN( I ) , 1=1, NTA) 
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RMAXD  (  I  )  =  RMAX  (  NT  I  N  (  I  )  ) 

END  DO 
END  IF 

READ(LOGN,200)  (FLAG2( I) , 1=1,3) 
IF  (FLAG2( 1) .SQ.l)  THEN 

READ ( LOGN ,300)  ( ROWMNE 1 ( I ) , I = 1 , NRA ) 

READ ( LOGN ,200)  ( NRO ( I ) , I = 1 , NRA ) 

READ ( LOGN ,200)  ( NRI N ( I ) , I = 1 , NRA ) 
END  IF 
IF  (FLAG2(2) . EQ . 1 )  THEN 

READ (LOGN, 300)  (ROWMNE 2 ( I ) , 1=1, IJA) 

READ( LOGN, 200)  ( A( I ) , I = 1 , IJA ) 

READ( LOGN, 20  0)  ( B ( I )  ,  I  =  1  ,  IJA) 
END  IF 
CLOSE (UN  I T  =  LOGN) 

C     Open  the  second  header's  file. 

OPEN ( UN I T=  LOGN , F I LE  =  H2  FNAME , STATUS= ' OLD '  ) 

REWIND  LOGN 

READ(LOGN, 100)  NC2 , NR2 , NC3 , NR3 , IJB,NT3 

C       If  the  two  headers  have  the  same  number  of  columns 
C      the  process  of  combination  is  continued. 

IF  (NCI .EQ.NC2 .AND. (NR1+NR2) . LE . 128)  THEN 
NCOL=NCl 
NROW=NRl+NR2 

READ( LOGN, 2  00)  (FLAG12( I) , 1=1,6) 
IF  (FLAG12Q)  .EQ.  1)  THEN 

FLAG1(1)=1 

NC=NCA+NCB 

READ ( LOGN ,300)  ( COLMNE ( I ) , I = 1 , NCB ) 

READ( LOGN, 200)  (NCOD( I ) , I=1+NCA,NC) 

READ ( LOGN ,200)  ( NC I N ( I ) , I = 1 , NCB ) 

DO  1=1, NCB 

COLMNED( I+NCA)=COLMNE(NCIN( I ) ) 

END  DO 

CALL  EXSHl(NCOD,NCIND,NC, 1) 

C      Combination  of  mnemonic  names. 

J=l 
K=l 
L  =  0 
DO  WHILE( J. LE.NC) 

IF  (NCOD(J) . EQ.NCOD( J  +  l) )  THEN 

NCO(K)=NCOD(J) 

COLMNE ( K ) =COLMNED ( NC I ND ( J ) ) 

NCIN(K)=K 

J=J  +  2 

K  =  K+1 
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L  =  L+1 
ELSE 

NCO(K)=NCOD( J) 
COLMNE ( K ) =COLMNED ( NCIND ( J ) ) 
NCIN(K)=K 
J=J  +  1 
K  =  K+1 
END  IF 
END  DO 
END  IF 
NC=NC-L 

IF  (FLAG12(2) . EQ . 1 )  THEN 
FLAG1(2)=1 
NT=NTA+NTB 

READ ( LOGN ,500)  ( RMIN( I ) , I =1 , NT3 ) 
READ ( LOGN ,500)  ( RMAX ( I ) , I = 1 , NTB ) 
READ (LOGN, 200)  (NTRD( I ) , I=1+NTA,NT) 
READ ( LOGN ,200)  ( NT I N ( I ) , I = 1 , NTB ) 
DO  1=1, NTB 

RMIND( I+NTA)=RMIN(NTIN( I ) ) 
RMAXD ( I +NTA ) =RMAX ( NT  I N ( I )  ) 
END  DO 

CALL  EXSH1(NTRD,NTIND,NT, 1) 
J  =  l 
K=l 
L  =  0 
DO  WHILE(J.LE.NT) 

IF  (NTRD(J) .EQ.NTRD( J+l) )  THEN 
NTR(K)=NTRD( J) 
RMIN(K)=MIN(RMIND(NTIND(J) ) , 

RMIND(NTIND(J+1) ) ) 
RMAX ( K ) =MAX ( RMAXD ( NT  I ND ( J )  )  , 

RMAXD(NTIND( J+l) ) ) 
NTIN(K)=K 
J=J  +  2 
K  =  K+1 
L  =  L+1 
ELSE 

NTR(K)=NTRD(J) 
RM I N ( K ) = RM I ND ( NT  I ND ( J )  ) 
RMAX(K)=RMAXD(NTIND( J) ) 
NTIN(K)=K 
J=J  +  1 
K  =  K+1 
END  IF 
END  DO 
END  IF 
NT=NT-L 

READ( LOGN, 200)  ( FLAG22 ( I ) , 1=1 , 3 ) 
IF  (FLAG22( 1) . EQ . 1)  THEN 
NR=NRA+NRB 
FLAG2( 1)=1 
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READ ( LOGN ,300)  ( ROWMNE 1(1), 1=1+ NRA , NR ) 

DO  J=1,NR3 

READ ( LOGN ,200)  NROD 
NRO(J+NRA)=NROD+NRl 
END  DO 
DO  J=1,NRB 

READ ( LOGN ,200)  NR I ND 
NRIN( J+NRA) =NRIND+NRA 
END  DO 
END  IF 

IF  (FLAG22(2) .EQ.l)  THEN 
FLAG2(2)=1 
IJ=IJA+IJB 
DO  1=1, IJB 

READ( LOGN, 300)  ROWMNED 
ROWMNE2( I+IJA)=ROWMNED 
END  DO 
DO  1=1, IJB 

READ( LOGN, 2  00)  AD 
A(  I+IJA)=AD+NRl 
END  DO 
DO  1=1, IJB 

READ( LOGN, 2  00)  BD 
B(  I+IJA)=BD+NRl 
END  DO 
END  IF 

CLOSE(UNIT=LOGN) 
NBYTES=NCOL*4 
WRITE( IMP, 600) 

CALL  FICH( ' 069' , LOGOLD1, 1 , DEVD I R, NAME , NR1 , MBYTES , 1, 
1  'DIRECT' ,LEC, IMP) 

WRITE( IMP, 700) 

CALL  FICH( '069' , LOGOLD2 , 1 , DEVDI R , NAME , NR2 ,N3YTES, 1 , 
1  'DIRECT' ,LEC, IMP) 

WRITE( IMP, 800) 

CALL  FICH( ' 069' , LOGNEW, 1 , DEVDI R , NAME , NR1+NR2 ,N3YTES, 
1  0, "DIRECT' ,LEC, IMP) 

DO  I=1,NR1 

READ(LOGOLDl ' I )  ( X ( J ) , J= 1 , NCOL ) 
WRITE (LOGNEW I )  (X(J) , J=l,NCOL) 
END  DO 
DO  I=1,NR2 

READ(LOGOLD2 ' I )  ( X ( J ) , J= 1 , NCOL ) 
WRITE  (LOGNEW  I -t-NRl)  (X(  J)  ,  J  =  l  ,  NCOL  ) 
END  DO 
ELSE 

WRITE ( IMP, 40  0) 
CLOSE (LOGOLD1 ) 
CLOSE (LOGOLD2) 
CLOSE (LOGNEW) 
RETURN 
END  IF 
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10  0    F0RMAT(6I5) 

200    F0RMAT(I5) 

300    FORMAT (A2 4) 

400    FORMAT (///4X, 'COMBINATION  IS  NOT  POSSIBLE  DUE  TO', 

1  7X,  'DIFFERENT  NUMBER  OF  COLUMNS!!') 

50  0    FORMAT (F 14. 6) 
600    FORMAT(/' 3 ', 3X, 'Assign  the  first  ''OLD''  direct  ', 

1       'access  file  : V4X,37( '-'  )  ) 
700    FORMAT (/'$', 3X, ' Assign  the  second  ''NEW'  direct', 

1       '  access  file  : */4X,37( '-•  )  ) 
800    FORMAT(/' $' ,3X, 'Assign  the  ''NEW'  direct  access  f 

1       */4X,37( '-' ) ) 

CLOSE (LOGOLD1) 

CLOSE (LOGOLD2) 

CLOSE (LOGNEW) 

RETURN 

END 


xe 


'************************************************************* 

SUBROUTINE  COMCOL  ( LEC , IMP , LOGN, NCOL , NROW , FLAG1 , FLAG2 , 

1  CO  LMNE , NC , NCO , NC I N ,  I J , A , 3 , ROWMNE 1 , NR , 

2  NRO,NRIN,ROWMNE2 , H1FNAMS , H2FNAME , 

3  RM I N , RMAX , NT , NTR , NT  I N ) 
********************************************************* 


Q*  ************  * 

c 

c 

Used  to 

c 

in  the  co 

c 

c 

ARGUMENTS 

c 

c 

LEC 

c 

c 

IMP 

c 

c 

LOGN 

c 

c 

NCOL 

c 

NROW 

c 

FLAG1 

c 

c 

c 

FLAG2 

c 

COLMNE 

c 

NC 

c 

NCO 

c 

c 

NCIN 

c 

IJ 

c 

A,B 

c 

c 

c 

ROWMNE 1 

merge  (combine)  two  data  files  and  thei: 
lumn-column  (one  aside  the  other)  sense 


lie  ad. 


The  logical 
terminal . 
The  logical 
terminal . 
The   logica 
will  be  sto 
The  number 
The  number 
Integer  arr 
to  indicate 
several  inf 
The  corresp 
Array  stori 
The  number 
The  numbers 
assigned  na 
The  invert 
The  number 
Arrays  stor 
starts  a   s 
correspondi 
Array  stori 


unit  number  for  writing   on   the 
unit  number  for  reading  from  the 

ch 


1  chanel  fo 
red  the  heade 
of  columns, 
of  rows, 
ay  of  six  ele 
the  existen 
ormations  reg 
onding  flag  f 
ng  the  column 
of  assigned  c 
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relative  addr 
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et  of  common 
ng  on  which  i 
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r   the  file  on  whi 
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ce   or   not   of   the 
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emonic  names. 
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c 

NR 

:  The 

c 

NRO 

:  The 

c 

ass 

c 

NRIN 

:  The 

c 

ROWMNE 2 

•   A  v  i- 

c 

H1FNAME 

:  The 

c 

wi  1 

c 

H2FNAME 

:  The 

c 

RMIN,RMAX 

:  Arr 

c 

val 

c 

goi 

c 

NT 

:  The 

c 

ext 

c 

NTR 

:  The 

c 

tra 

c 

NT  IN 

:  The 

c 

£******************** 

number  of  assigned  row  mnemonic  names, 
numbers   of   rows   for   which  have  been 
igned  names. 

invert  relative  addresses  of  ROWMNE. 
ay  storing  the  mnemonics  of  se*s  of  rows. 
name  of  the  first   header's  file   which 
1  be  merged. 

name  of  the  second  file  for  merging. 
ays   storing   the  minimum  and  the  maximum 
ues  between   which  tracing  of  the  data  is 
ng  to  take  place. 

number   of   columns   for   which   tracing 
rema  have  been  assigned. 

column   numbers   for   which   for   which 
cing  ext rema  have  been  assigned. 

invert  relative  addresses  for  RMI,RMAX. 


,NRO( 128) 
FLAG12(6) 
1 2  8 )  , NC I N 


,A( 

,FL 

(12 


IMPLICIT  INTEGER*2  (I-N) 

1NTEGER*2    FLAGK6)  ,  FLAG2  (  3)  ,NCO(128 

1  B(128) ,NTR(128) ,NROD(128) 

2  NTRD,NTIN( 128) ,NTIND,NRIN 

3  NR I ND ( 1 2  8 )  , NC I ND 

CHARACTER*24  COLMNE( 128 ) , H1FNAME , H2FNAME , ROWMNE I 
1  ROWMNE 1( 128) , R0WMNE2( 128) , ROWMNE D 

REAL* 4  RMIN( 128) ,RMAX(128) , RMIND( 128) ,RMAXD( 12  8) 
CHARACTER*45  DEVDI R , NAME*10 


123  )  , 
AG22( 

3), 

Dl  123 
,X(12 


3), 


DATA  DEVDIR,NAME/'DUAO  :','   '/ 
DATA  LOGNEW,LOGOLDl,LOGOLD2/3 ,1,2/ 


0PEN(UNIT=L0GN,FILE=H1FNAME,STATUS= 'OLD' ) 

REWIND  LOGN 

READ( LOGN, 100 )  NCI , NR1 , NCA , NRA , IJA,NTA 

READ (LOGN, 20  0)  ( FLAG1 ( I )  ,  I  =  1 , 6  ) 

.1)  THEN 

0 )  ( COLMNE ( I ) , I = 1 , NCA ) 
0 )  ( NCO ( I ) , I = 1 , NCA ) 
0)  (NCIN( I ) , 1=1, NCA) 


IF  (FLAGK  1)  , 

,EQ 

READ (LOGN, 

,  30 

READ (LOGN, 

,20 

READ (LOGN, 

,20 

END  IF 

IF 


EQ 


FLAGK  2 
READ (LOGN, 5  0 
READ(LOGN,50 
READ (LOGN, 2  0 
READ (LOGN, 2  0 
END  IF 

READ (LOGN, 200 ) 

IF  (FLAG2( 1) .EQ 

READ (LOGN, 3  0 

READ (LOGN, 2  0 

READ (LOGN, 2  0 


. 1 )  THEN 

0 )  (RMIN( I ) , I=1,NTA) 
0 )  (RMAX( I ) , I=1,NTA) 
0)  (NTR( I ) , 1=1, NT A) 
0 )  (NTIN( I ) , I=1,NTA) 

(FLAG2( I ) , 1=1, 3) 

.1)  THEN 

0)  ( ROWMNE 1( I ) , 1=1 ,NRA) 

0)  (NROD( I ) , 1=1, NRA) 

0 )  (NRIN( I ) , 1=1, NRA) 
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DO  1=1, NRA 

ROWMNE 1 D (  I ) =  ROWMNE 1 ( NR I N ( I )  ) 
END  DO 
END  IF 
IF  (FLAG2(2) . EQ . 1 )  THEN 

READ(LOGN, 300 )  (ROWMNE 2 ( I ) , 1=1, IJA) 
READ (LOGN, 2  00)  ( A( I ) , 1=1 , IJA) 
READ (LOGN, 20  0)  ( B ( I ) , I =1 , IJA ) 
END  IF 

CLOSE ( UNI T= LOGN) 

OPEN(UNIT=LOGN,FILE=H2FNAME,STATUS= 'OLD' ) 
REWIND  LOGN 

READ (LOGN, 10  0)  NC2 , NR2 , NCB , NR3 , IJ3,NT3 
IF  (NR1.EQ.NR2.AND.NC1+NC2.LE.128)  THEN 
NROW=NRl 
NCOL=NCl+NC2 

READ( LOGN, 200)  ( FLAG12 ( I ) , I =1 , 6 ) 
IF  (FLAG12(1) .EQ.l)  THEN 
NONCA+NCB 
FLAG1(1)=1 

READ (LOGN, 300)  (COLMNE( I ) , I=1+NCA,NC 
DO  1=1, NCB 

READ (LOGN, 20  0)  NCOD 
NCO( I+NCA)=NCOD+NCl 
END  DO 
DO  J=1,NCB 

READ( LOGN, 20  0)  NCIND 
NCIN(J+NCA)=NCIND+NCA 
END  DO 
END  IF 

IF  (FLAG12( 2) .EQ.l)  THEN 
NT=NTA+NTB 
FLAG1(2)=1 

READ (LOGN, 500)  (RMIN( I ) , I=NTA+1,NT) 
READ (LOGN, 500)  ( RMAX ( I ) , I=NTA+1,NT) 
DO  J=1,NT3 

READ( LOGN, 200)  NTRD 
NTR(J+NTA)=NTRD+NC1 
END  DO 
DO  J=1,NTB 

READ( LOGN, 200)  NTIMD 
NTIN( J+NTA) =NTIND+NTA 
END  DO 
END  IF 

READ( LOGN, 200)  ( FLAG2 2 ( I )  ,  I  =  1  ,  3  ) 
IF  (FLAG22Q)  .EQ.l)  THEN 
FLAG2(1)=1 
NR=NRA+NRB 

READ (LOGN, 3  00)  ( ROWMNE 1( I ) , I = 1 , NRB ) 
READ( LOGN, 200)  (NROD( D , I=1+NRA,NR) 
READ ( LOGN ,200)  ( NR I N ( I ) , I = 1 , NRB ) 
DO  1=1, NRB 
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ROWMNE I D  (  I  -  N'RA  )  =  ROWMNE 1 ( NR I N ( I ) ) 

END  DO 

CALL  EXSH1(NRCD,NRIND,NR,1) 

J=l 
K=l 
L  =  0 
DO  WHILE  (J.LE.NR) 

IF  (NROD(J) .EQ.NROD(J+l) )  THEN 
NRO(K)=NROD( J) 

R0WMNE1(K)=R0WMNE1D(NRIND( J) ) 
NRIN(K)=K 
J=J  +  2 
K  =  K+1 
L  =  L+1 
ELSE 

NRO(K)=NROD(J) 

ROWMNSl(K) =R0WMNE1D(NRIND( J) ) 
NRIN(K)=K 
J  =  J  +  1 
K=K+1 
END  IF 
END  DO 
END  IF 
NR=NR-L 

CLOSE (UNIT=LOGN) 
NBYTES=NC1*4 
WRITE( IMP, 600) 

CALL  FICH(  '069'  , LOGOLD1, 1 , DEVDI R , NAME , NR1 , MBYTES , 
1  1, 'DIRECT' ,LEC, IMP) 

NBYTES=NC2*4 
WRITE( IMP, 700) 

CALL  FICH( ' 069' , LOGOLD2 , 1 , DEVDIR, NAME , NR2 , NBYTES , 
1  1  ,  'DIRECT'  ,LEC, IMP) 

NBYTES=(NC1>NC2) *4 
WRITE( IMP, 800 ) 

CALL  FICH(  ' 069  '  , LOGNEW, 1 , DEVDI R , NAME , NR1+NR2 , 
1  NBYTES, 0, 'DIRECT' ,LEC, IMP) 

DO  I=l,NROW 

READ(LOGOLDl" I )  ( X ( J ) , J= 1 , NCI ) 
READ(LOGOLD2 ' I )  (X(J) ,J=NC+1,NC2) 
WRITE( LOGNEW I )  ( X ( J ) , J= 1 , NC2 ) 
END  DO 
END  IF 
100    F0RMAT(6I5) 
20  0    FORMAT(I5) 
300    FORMAT (A2 4) 
400    FORMAT(///4X, 'COMBINATION  IS  NOT  POSSIBLE  DUE  TO', 

1  7X, 'DIFFERENT  NUMBER  OF  ROWS!!') 

50  0    FORMAT (F 14 .6) 
600    FORMAT(/' $', 3X, 'Assign  the  first  ''OLD''  direct', 

1        '  access  file  :  '/4X,37(  '  -  '  )  ) 
700    FORMAT(/' $', 3X, ' Assign  the  second  ''NEW'  direct  ', 
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1        'access  file  :  V4X,37( '-' ) ) 
00    FORMAT (/'$', 3X, ' Assign  the  ''NEW'  direct  access  file  : 
1       '/4X,37( '-' ) ) 
CLOSE(LOGOLDl) 
CLOSE (LOGOLD2 ) 
CLOSE (LOGNEW) 
RETURN 
END 


SUBROUT I NE  EXTREE ( A , NO , N , I ND ) 

C 

C   Subroutine   for  internal  and  address  calculation  sort  using 

C   the   tree  sort  ("Monkey-puzzle  sort")  to  obtain  the  rank  of 

C   the  X's,  in   this   case   the   original   array   X()   is   not 

C   modified. 

C 

C   If  the  X()  are  in  random  order  the  number  of  comparisons  is 

C   of   the   order  of   N  log2(N);  if  the  X()  are  already  in  the 

C   required  order   or   reverse  order  the  number  of  comparisons 

C   is  of  the  order  of  N*N/2. 

C 

C   ARGUMENTS : 

C 

Elements  to  sort. 

Address  calculation  for  the  rank. 

Number  of  elements  to  sort. 

If  >0 ,  elements   are   sorted   in  ascending  order,  if 

not,  in  descending  order. 

2048  items  maximum. 


C  X 

C  NO 

C  N 

C  IND 
C 

c 
c 

C  Reference  : 

C   Windley  P.F.  (1960)  :  "Trees,  Forests  and  Rearranging", 

C   Computer  J,  vol.3,  no . 2 ,  July,  p. 84-88. 

C 

£********************************** 

c 

IMPLICIT  INTEGER*2  (l-N) 
C 

c 

c 
c 
c 


INTEGER* 2  I  LB ( 2048), I RB( 2048)  , NO (2048) 

REAL* 4  A(2048),AI,AJ 

Place  at  first  A(l)  on  the  root. 

ILB(1)=0 
IRB(1)=0 
DO  I=2,N 

ILB( I )=0 

IRB( I )=0 
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C     Select  the  root  of  the  tree  as  the  item  for  comparison. 

J=l 
K=l 
DO  WHILE(K.EQ.l) 

K  =  0 
C 

C  Permutation  in  function  of  IND. 

C 

I F ( I ND . GT . 0 )  THEN 
C 

C  Sort  by   ascending  order. 

C 

AI=A( I ) 

AJ=A(J) 
ELSE 
C 

C  Sort  by  descending  order. 

C 

AI=A(J) 

AJ=A( I ) 
END  IF 
C 

C     Compare   the   new   item  with  the  item  for  comparison.  If 
C      the  new  item  should  follow, 
C 

IF(AI.GE.AJ)  THEN 
C      If  the  item   for  comparison  has  a  right  brance,  take  the 
C      item  to   which   that   branch   points  as  the  new  item  for 
C     comparison, 
C 

IF  ( IRB(J) . LE.O)  THEN 
C 

C     Copy  the   backtrack   of  the  item  for  comparison  into  the 
C     backtrack  of  the   new  item,  and  set  the  right  pointer  of 
C      the  item  for  comparison  to  point  to  the  new  item. 
C 

I  RB (  I  )  =  I RB ( J ) 
I RB ( J )  =  I 

ELSE 

J=IRB(J) 
C 

C  Make  the  backtracks  of  the  new  item  point  to  the  item 
C  for  comparison,  and  set  the  left  pointer  of  the  item  for 
C     comparison  to  point  to  the  new  item. 

K=l 
END  IF 
ELSE 
C 

C  If  the  item  for  comparison  has  a  left  branch,  take  the 
C      item   to   which   that   branch  points  as  the  new  item  for 
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C      comparison. 
C 

IF  ( ILB(J) .EQ.O)  THEN 
IRB( I )=-J 
ILB( J)=I 
ELSE 

J=IL3(J) 
K  =  l 
END  IF 
END  IF 
END  DO 
END  DO 
C 

C     Start  with  the  item  at  the  root  of  the  tree. 
C 

M=0 
C 

J=l 
K=l 

DO  WHILE  (K.EQ. 1) 
K=0 
C 

C      If   this   item  has  a  left  branch,  take  the  item  to  which 
C      that  branch  points. 
C 

IF( ILB(J) .GT.O)  THEN 
J=ILB(J) 
K=l 
ELSE 
L=l 
C 

C     This  is  the  next  item  in  order. 
C 

DO  WHILE  (L.EQ. 1) 
L  =  0 
C 

C  Ordered  item  found,  adress  NO(). 

C 

M=M+1 
NO(M)=J 
C 

C      If  this   item  has  a  right  branch,  take  the  item  to  which 
C      that  branch  ooints. 
C 

IF( IRB( J) . NE.O)  THEN 

IF( IRB( J) .GT.O)  THEN 
J=  IRB(J) 
K=l 
ELSE 

J=-IRB(J) 
C 
C     Take  the  item  to  which  the  backtrack  points. 
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L=l 

END  IF 
ELSE 
C  End  of  process. 

RETURN 
END  IF 
END  DO 
END  IF 
END  DO 
END 

SUBROUTINE  RANDOM (LEC, IMP , NCOL , NROW ) 
p***************************************^ 

C 

C  Used   to   randomize   the   data   matrix   of   an   assigned 

C  mass-storage  file. 

C 

C  ARGUMENTS  : 

C 

C  LEC   :  The   logical   unit   number   for   writing   on   the 

C  terminal . 

C  IMP   :  The   logical   unit   number   for   reading  from  the 

C  terminal. 

C  NCOL  :  The  number  of  columns. 

C  NROW  :  The  number  of  rows. 

C 

IMPLICIT  INTEGER*2  (I-N) 

REAL*4  XRAN(2048) 

INTEGER* 2  AR(128),NO(128),INIT(6) 

CHARACTER* 4 5  DEVDI R , NAME* 10 

REAL*4  X(128)  ,Y(128) 

DATA  DEVDIR,NAME/' DUAO  :','   '/ 

DATA  LOGOLD/2/ 

DATA  INIT/59,47,62 , 38 ,45,  23/ 

DATA  INDRAN/1/ 

NBYTES=NCOL*4 

WRITE( IMP, 100) 

CALL  FICH( ' 069' ,LOGOLD, 1 , DEVD I R , NAME , NROW , N3YTES , 1, 

1  ' DIRECT' , LEC, IMP) 

DO  1=1, NROW 

XRAN ( I ) =  RANDAN (  I N I T ,  I NDRAN ) 
END  DO 
C      Use  tree  sort  because  data  are  randomized. 
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CALL  SXTREE ( XRAN , NO , NROW , 1 ) 
DO  1=1, NRCW 

READ (LOGOLD' I )  (X(J) ,J=l,NCOL) 

READ ( LOGOLD ' NO ( I ) )  ( Y ( J ) , J=l , NCOL ) 

WRITE (LOGOLD' I )  (Y(J) , J=l,NCOL) 

WRITE ( LOGOLD' NO ( I ) )  (X(J) ,J=l,NCOL) 

J=I 

DO  WHILE(NO(J) .NE. I ) 
J=J+1 

END  DO 

NO(J)=NO( I ) 
END  DO 

CLOSE (LOGOLD) 
RETURN 
100    FORMAT(/' $', 3X, ' Assign  the  ''OLD''  direct  access  file  : 
1       '/4X,37( '-' ) ) 
END 

FUNCT I ON  RANDAN ( I N I T , I ND ) 

c 

IMPLICIT  INTEGER*2  (I-N) 
C 

C 

c 
c 
c 


c 
c 


DOUBLE  PRECISION  X 

INTEGER*  2  A(  6  )  ,  INIT  (  6  )  ,  LN(  6  )  ,  LNPK6)  ,C,P,Q 

DATA  M/36/Q/6/A/5  9,4  7,62,38,4  5,2  3/ 

IF( IND.NE.0)THEN 

1=0 

DO  WHILE  ( I . LT.Q) 

1  =  1  +  1 

LN( I )=INIT( I ) 
END  DO 

IND=0 

ELSE 
END  IF 

C  =  0 
K  =  Q 

MQ=M/Q 
IMQ=2 . **MQ 

DO  WHILE  (K.GT.O) 
IQMK=Q-K 
.  1  =  0 
P=0 
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DO  WHILE  ( I .LE. IQMK) 
P=P+A( I+K) *LN(Q-I ) 
1  =  1  +  1 
END  DO 
P  =  P  +  C 
C=P/IMQ 

LNP1(K)=P-C*IMQ 
K=K-1 
END  DO 

1  =  0 
X=0 .DO 


C 

c 

c 


DO  WHILE  ( I . LT.Q) 

1  =  1  +  1 

X=X+LNP1( I)*2. **(-MQ*I 

LN( I )=LNP1( I ) 
END  DO 

RANDAN=X 

RETURN 

END 


SUBROUTINE  FINDMM  ( LEC , IMP , NCOL , NROW, FMIN , FMAX ) 
r*  ***********************************************************  * 

IMPLICIT  INTEGER*2  (I-N) 
REAL*4  X(128)  ,FMIN( 128)  ,FMAX(128) 
CHARACTER* 4 5  DEVDIR , NAME* 10 
DATA  DEVDIR, NAME/ ' DUAO  :','  '/ 
DATA  LOGOLD/2/ 

DO  J =1, NCOL 

FMIN(J)=+l.E+38 

FMAX( J)=-l.E+38 
END  DO 

WRITE( IMP, 100) 

NBYTES=NCOL*4 

CALL  FICH    (' 069'  ,LOGOLD,  1  ,  DEVDIR,  NAiME,  NROW,  NBYTES,  1  , 

1  'DIRECT' ,  LEC, IMP) 

DO  1=1, NROW 

READ(LOGOLD' I )  ( X ( K ) , K= 1 , NCOL ) 
DO  J=l,NCOL 

IF  (FMIN(J) .GT.X(J) )  THEN 

FMIN(J)=X(J) 
END  IF 

I F  ( FMAX ( J ) . LT . X ( J ) )  THEN 
FMAX(J)=X( J) 
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END  IF 
END  DO 
END  DO 

CLOSE (LOGOLD) 
RETURN 
100    FORMAT(/ '$', 3X, 'Assign  the  ''OLD''  direct  access  file  : 
1       V4X,37(  '-*  )) 
END 

SUBROUT I NE  CONV ( NCOL , NROW , COLMNE , NC , I NDEX ) 

C 

C  This  subroutine  analyzes  the  expression   inserted  by  the 

C  keyboard  in  the  form  of  string  in  the  following  kinds  of 

C  elements: 

C  .  Functions  (eg.  SQRT[7]) 

C  .  Row  assignment  (eg.  [8]) 

C  .  Reals  or  integers 

C  .  Delimiters  (  eg  ."  (",'*)"  ) 

C  .  Operators  :  '+' ,'-",' *' ,'/',' ~ ' 

C  The  result   of   this   analysis   is   an   infix  expression 

C  consisted   of   the   above   kind   of   elements,   but    in 

C  characters. 

C 

C  ARGUMENTS : 

C 

C  NCOL    :  The  number  of  columns. 

C  NROW    :  The  number  of  rows. 

C  COLMNE  :  Array  storing  the  column  mnemonic  names  and  the 

C  assigned  transformations. 

C  NC      :  The  index  of  the  array  COLMNE. 

C  INDEX   :  Pointer  marking  the  index  of   COLMNE   on   which 

C  the  transformations  start. 

C 

IMPLICIT  INTEGER*2  (I-N) 

INTEGER*2  CN,PP 

REAL*4  X(128) , ARG , VAL,R,RES 

CHARACTER* 2 4  COLMNE (12  8), STR I NG 

CHARACTER* 1  SYMB(24) , INF ( 18, 14) , POST ( 18, 14) ,F(7) , NUM ( 3 ) , 

1  CONS (14) ,3R 

CHARACTER* 5  FUN 

CHARACTER* 4 5  NAME* 10 , DEVDI R 

LOGICAL*l  MARK, TEST, NEG, CHECK 

EQU I  VALENCE ( SYMB ( 1)  , STRING) 

DATA  DEVDIR,NAME/'DUAO  :','"/ 
DATA  LOGOLD , LOGNEW/ 2,3/ 
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NBYTES=(NCOL-(NC- INDEX)  >*4 

C     Open  the  file  which  contains  the  data  to  be  transformed, 

WRITE  (6,300) 

CALL  FICH( ' 069' , LOGOLD, 1 , DEVDIR , NAME , NROW , N3YTES , 1, 

1  'DIRECT' ,5,6) 

NBYTES=NCOL*4 

C  Open  a  new  file  with  the  same  name,  on  which  z'r.e 
C      transformed  data  will  be  stored. 

WRITE  (6,400) 

CALL  FICH( ' 069' ,LOGNEW, 1 , DEVDIR, NAME , NROW, NBYTES , 0 , 

1  'DIRECT' ,5,6) 

C  For  each  row  of  the  data  matrix,  execute  the  assigned 
C      transformation. 

DO  JK=l,NROW 
C        Read  the  entire  row  of  data. 

READ ( LOGOLD ' JK )  (X(K) ,K=1 , NCOL- ( NC- INDEX ) ) 
C        Calculate  the  number  of  transformations  (IND). 

IND=NC-INDEX 
C        For  each  transformation, 

DO  IK=1,NC-INDEX 

C  Store  the  expression  representing  the  transformation 
C  in  the  variable  STRING.  In  following  this  string  will  be 
C      analyzed. 

STRING=COLMNE( IK+ INDEX) 

C        Initialize  the  pointers. 

J=l 

N=l 
L=l 
M=l 
IP=1 
BR='  ' 

C        Initialize  the  flags. 

TEST=. FALSE. 
MARK-. FALSE. 
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CHECK=. FALSE. 
NEG= .FALSE. 

C        For  each  character  of  the  string, 

DO  1=1,24 

C  If  the  character   is   a  letter,   store   it  in  the  one 

C  character  array  F  and   signal   the   encountering  of  a 

C  function  in  the  transformation   by   seting   the   flag 

C  TEST  to  true. 

IF  (SYMB(I) .GE. 'A* .AND.SYMB(I) . LE . *Z* )  THEN 

F(N)=SYMB( I ) 

TEST=.TRUE. 
N=N+1 

C  If  the  character  is  number  or  ".",  then 

ELSE  IF  (  (SYMB( I )  . GE .  ' 0  *  .AND.SYM3( I )  .LE.  ' 9'  )  .OR 
1  SYMB( I ) .EQ. ' . ' )  THEN 

C  If  the  bracket  is  closed  or  no  bracket  has  still 

C  been  encountered,  the  number  is  a  constant   used 

C  by   the   transformation.  Store  the  number  in  the 

C  array   CONS   and   mark   the   encountering   of   a 

C  constant  by   seting  the   flag  MARK  to  true. 

IF  (BR.EQ. ' ] ' .OR.BR.EQ. '   ' )  THEN 
CONS(L)=SYMB( I ) 
MARK=.TRUE. 
L  =  L  +  1 

C  Else  if  the  bracket  is  opened,  then 

ELSE  IF  (BR.EQ. '[' )  THEN 

C  if   function  has  been  encountered,  the  number 

C  is  the  representation   of   the   column  number 

C  the  value  of  wich   is   going  to   be   used   as 

C  argument  of  the  function. 

I F  ( TEST . EQ . . TRUE . )  THEN 
F(N)=SYMB( I ) 
N  =  N+1 

C  Else,  the  number  is  the  representation  of 

C  column   but   the   coresponding   value   is 

C  going   to  be  used  as  a  constant. 

ELSE 

NUM(M)=SYMB( I ) 


176 


CHECK=.TRUE. 
M=M+1 

END  IF 
END  IF 

C  If  the  character  is  "[",  set  it  to  variable  BR 

ELSE  IF  (SYMB(I) . EQ . ' [ ' )  THEN 

BR=SYMB( I ) 

C  if  function  has  been  encounterd,  store   the  "[" 

C  in  the  same  array  with  the  function  (F) 

I F  ( TEST .EQ. . TRUE . )  THEN 
F(N)=SYM3( I ) 
N=N+1 

C  else   store   it   in   the  same  array  with  the 

C  numbers  representing  columns. 

ELSE 

NUM(M)=SYMB( I ) 

M=M+1 
END  IF 

C  Else  if  the  symbol  is  "]"  then  set  it  to  variable 

C  BR  and, 

ELSE  IF  (SYMB( I ) . EQ . ' ] ' )  THEN 
BR=SYMB( I ) 

C  if  function  has  been  encountered,   store  it  in 

C  the  same  array 

I F  ( TEST . EQ . . TRUE . )  THEN 
F(N)=SYMB( I ) 

C  else   store   it   with   the  mumber  representing 

C  column. 

ELSE 

NUM(M) =SYMB( I ) 
END  IF 

C  Else  if  the  symbol  is  "-",  then 

ELSE  IF  (SYMB( I ) . EQ . ' - ' )  THEN 

C  if   the   previous   character   was  "(",  means  that 

C  follows  negative  number  and  mark  it  by  setmg  the 

C  flag  NEG  to  true. 
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IF  (SYM3( 1-1) .EQ. ' ( ' )  THEN 
NEG=.TRUE. 

C  Else  the  character   "-"   represents  the  symbol 

C  of  the  subtraction. 

ELSE 

C  If  function  has  been  encountered, 

I F  ( TEST . EQ . . TRUE . )  THEN 

C  If   the   NEG  flag  is  true  the  "-"  is  placed 

C  at  the  begining   of  the  function  storing  in 

C  the  generated  infix  expression. 

IF  ( NEG. EQ. .TRUE. )  THEN 
INF( IP, 1)= ' - ' 

C  and  in  followng  the  function  name  stored 

C  in  the  array  F  is   also   placed   in   the 

C  infix  expression. 

DO  J  =  1  ,  N 

INF( IP, J+1)=F( J) 
END  DO 

C  Since   the   "-"   is   used   to  negate  the 

C  function  the  flag  is  reset  to  FALSE, 

NEG=. FALSE. 

C  and  the   pointer   of  the  generated  infix 

C  expression  IP,  is  increased. 

IP=IP+1 

C  The  "("  is  also  placed  as  element  of  the 

C  infix, 

INF( IP, 1 )=SYMB( I ) 
IP=IP+1 

C  and  the  flag   TEST   is  reset  to  FALSE  to 

C  indicate  that  no  function  is  active. 

TEST=. FALSE. 

C  The   index   of   array   F   is  set  to  one, 

C  ready  -to  accept  the  next  fuction  name. 

N=l 
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C  Else   (the   function   is   not   negative) 

C  repeat  the  same  procces  without  negating 

C  the  function. 

ELSE 

DO  J= 1 , N 

INF(IP,J)=F(J) 

END  DO 

IP=I?+1 

INF ( IP, 1)=SYMB( I ) 

IP=IP+1 

TEST=. FALSE. 
N=l 
END  IF 

C  Else  if  constant  has  been  encountered, 

ELSE  IF  (MARK. EQ. .TRUE. )  THEN 

C  if   the  NEG  flag  is  set,  place  the  constant 

C  stored   in   array   CONS   in   the   generated 

C  infix  expression  but  negeting  it  first. 

IF  ( NEG. EQ. .TRUE. )  THEN 
INF( IP, 1)=' -' 
DO  J=1,L-1 

INF( IP,J+1)=C0NS(J) 
END  DO 
NEG=. FALSE. 
IP=IP+1 

INF( IP, 1)=SYMB( I ) 
IP=IP+1 
MARK=. FALSE. 
L=l 

C  Otherwise  do  the  same  without  negation. 

ELSE 

DO  J=1,L-1 

INF( IP, J)=CONS(J) 

END  DO 

IP=IP+1 

INF ( IP, 1)=SYMB( I ) 

IP=IP+1 

MARK=. FALSE. 

L=l 
END  IF 

C  Repeat  the  same  process  if  number  representing 

C  column  has  been  encountered. 
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ELSE  IF  ( CHECK. EQ . .TRUE. )  THEN 
I F  ( NEG . EQ . . TRUE . )  THEN 
INF( IP, 1)= ' -' 
DO  J=1,M 

INF(IP,J+1) =NUM(J) 
END  DO 
NEG=. FALSE. 
IP=IP+1 

INF ( IP, 1)=SYMB( I ) 
IP=IP+1 
CHECK=. FALSE. 
M=l 
ELSE 

DO  J  =  1,M 

INF( IP, J)=NUM(J) 
END  DO 
IP=IP+1 

INF( IP, 1)=SYMB( I ) 
IP=IP+1 
CHECK=. FALSE. 
M=i 
END  IF 
END  IF 
END  IF 


C 
C 
C 

c 
c 


If  the  character  is  an  operator  or  end  of  string  is 
encountered,  the  current  active  funct ion , constant  or 
column  value  must  be  placed  in  the  generated  infix 
expression.  The  same  process  used  above  for  the  "-" 
is  going  to  be  used  herein  also. 


ELSE  IF  ( (SYMB( I ) . EQ . ' ( ' .OR.SYMB( I ) . EQ . ' ) ' .OR. 
SYMB( I ) .EQ. ' +' .OR. 

SYMB ( I ) . EQ . ' * ' . OR . SYMB ( I ) . EQ . ' / ' . OR . 
SYMB  (  I )  .  EQ .  ,/N  '  .  OR .  SYMB  (  I  )  .  EQ .  *  '  )  .  AND 
SYMB( 1-1) .NE. '   ' )  THEN 


I  F  ( TEST . EQ .  . TRUE .  )  THEN 
I F  ( NEG . EQ . . TRUE . )  THEN 
INF( IP, 1)=' -' 
DO  J  =  1  ,  N 

INF( IP,J+1)-F(J) 
END  DO 
NEG=. FALSE. 
IP=IP+1 

INF ( IP, 1)=SYMB( I ) 
IP=IP+1 
TEST=. FALSE. 
N=l 
.  ELSE 

DO  J  =  1  ,  N 

INF( IP,J)=F(J) 
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END  DO 
IP=IP+I 

INF ( IP, 1)=SYMB( I ) 
IP=IP+1 

TEST= .FALSE. 

N=l 
END  IF 
ELSE  IF  ( MARK. SQ. .TRUE. )  THEN 
I F  ( NEG . EQ . . TRUE . )  THEN 

INF( IP, 1)=' - ' 

DO  J=1,L-1 

INF( IP, J+l)=CONS( J) 

END  DO 

NEG=. FALSE. 

IP=IP+1 

INF( IP,1)=SYM3( I) 

IP=IP+1 

MARK= . FALSE . 

L=l 
ELSE 

DO  J=1,L-1 

INF( IP,J)=CONS(J) 

END  DO 

IP=IP+1 

INF ( IP, 1)=SYMB( I ) 

IP=IP+1 

MARK=. FALSE. 

L=l 
END  IF 
ELSE  IF  ( CHECK. EQ. .TRUE. )  THEN 
IF  (NEG. EQ. .TRUE. )  THEN 

INF( IP, 1)=' -' 

DO  J=1,M 

INF( IP, J+1)=NUM(J) 

END  DO 

NEG= . FALSE . 

IP-IP+1 

inf( ip, 1)=symb( i ) 
ip=ip+i 

check=. false. 

M=l 
ELSE 

DO  J  =  1,M 

INF( IP, J)=NUM(J) 
END  DO 
IP=IP+1 

INF ( IP, 1)=SYMB( I ) 
IP=IP+1 

CHECK=. FALSE. 
M=l 
END  IF 
ELSE  IF  (TEST. EQ. . FALSE. .AND. MARK. EQ. .FALS; 
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2  . AND. CHECK. EQ. .FALSE, )    THEN 

INF ( IP, 1)=SYMB( I ) 

rp=ip+i 

END  IF 
END  IF 
END  DO 
IP=IP-2 

C  As  soon  an  infix  expression  is  generated,  the  process 
C  for  its  evaluation  is  continued,  by  calling  the 
C      appropriate  subroutines. 

CALL  PFIX( INF, POST, IP,PP) 

CALL  EVAL ( LOGOLD , POST , RES , PP , I NDEX , NC , JK , NCOL , 
1  X,FUN,ARG, I  ERR) 

C  The  result  is  placed  in  one  position  after  the  last 
C      column  increasing  the  numbers  of  column  by  one. 

X(NCOL-IND+l)=RES 

C  One  transformation  has  been  evaluated  and  their  number 
C       is  decreased. 

IND=IND-1 
END  DO 

C  If    the  flag  IERR  used  to  signal  that  invalid  argument 

C  for  a  function  has  been  encountered  (eg.  Square  root  of 

C  negative   number)  is  not  set  then  the  new  row  (contanig 

C  the  transformed  columns)  is  written  to  the  new  file. 

IF  (  IERR.  NE.  LAND.  IERR.  NE.  2)  THEN 
WRITE (LOGNEW'JK)  (X(K) ,K=1,NC0L) 

C  Else  a  message  is  displayed  and  the  program  returns  for 
C      new  assignement. 

ELSE  IF  (IERR.EQ.1)  THEN 
WRITE (6, 100)  FUN,ARG 
CLOSE (LOGNEW) 
RETURN 
ELSE 

WRITE(6,200) 
CLOSE (LOGNEW) 
RETURN 
END  IF 
END  DO 

CLOSE (LOGNEW) 
RETURN 
100    FORMAT(//4X, ' INVALID  FUNCTION  ARGUMENT  :  ' , A5 , ' ( ' , 
1        F14.6, ' ) ' ) 
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200    FORMAT (//4X, ' INVALID  DIVISION  3Y  0  ! ! ' ) 

300    FORMAT (//4X, 'Assign  the  ''OLD'1  direct  access  file  :' 

i        /4X      ,37( '-' )) 
400    FORMAT  (//4X,  'Assign  the  ''NEW'  direct  access  file  :' 

1        /4X      ,37(  '-' )) 

END 

£xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx^ 

SUBROUT I NE  COMP ( FUN , ARG , AP , I ERR ) 

c 

C  This   subroutine   is   used   to  compute  the  values  of  the 

C  functions  that  may  be  included  in  a  transformation  using 

C  the  FORTRAN  77  build-in  functions. 
C 

c 

C      ARGUMENTS : 
C 


Name  of  the  function. 

Argument  of  the  function. 

Result  of  the  function. 

Flag   indicating   that   an   invalid   argument   is 


C  FUN 

C  ARG 

C  AP 

C  I  ERR 

C  assigned. 

C 

£xxxxxxxx*xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx^ 

IMPLICIT  INTEGER*2  (i-P) 
CHARACTER* 5  FUN 
REAL* 4  ARG,AP,AX 

IERR=0 

IF       (FUN.EQ.'  SQRT')  THEN 
IF  (ARG.GE.0)  THEN 

AP=SQRT(ARG) 
ELSE 

IERR=1 
END  IF 

C  Use  the  build  in  intrincic  functions  of  FORTRAN  77  for 
C  the  computation  of  the  several  assigned  by  the 
C      expression  functions. 

ELSE  IF  (FUN.EQ.'   LOG')  THEN 
IF  (ARG.LE.0)  THEN 

AP=ALOG(ARG) 
ELSE 

IERR=1 
END  IF 
ELSE  IF  (FUN.EQ.'  LOGC ' )  THEN 
IF  (ARG.LE.0)  THEN 

AP=LOG10(ARG) 
ELSE 


183 


IERR=1 

END  IF 
ELSE  IF  (FUN.EQ. 

AP=EXP(ARG) 
ELSE  IF  (FUN.EQ. 

AP=SIN(ARG) 
ELSE  IF  (FUN.EQ. 

AP=COS(ARG) 
ELSE  IF  (FUN.EQ. 

AP=TAN(ARG) 
ELSE  IF  (FUN.EQ. 

AP=ASIN(ARG) 
ELSE  IF  (FUN.EQ. 

AP=ACOS(ARG) 
ELSE  IF  (FUN.EQ. 

AP=ATAN(ARG) 
ELSE  IF  (FUN.EQ. 

AP=ABS(ARG) 
ELSE  IF  (FUN.EQ. 

AP=SINH(ARG) 
ELSE  IF  (FUN.EQ. 

AP=COSH(ARG) 
ELSE  IF  (FUN.EQ. 

AP=TANH(ARG) 


EXP' 

THEN 

SIN' 

THEN 

'   COS' 

THEN 

TAN' 

THEN 

1  AS  I N ' 

THEN 

'  ACOS ' 

THEN 

'  AT AN ' 

THEN 

ABS' 

THEN 

'  S I NH ' 

THEN 

'  COSH' 

)  THEN 

'  TANH ' 

)  THEN 

c 
c 


Compute  the  Arc  Hyperbolic  Sin  function  not   included  in 
the  build  in  functions  of  the  language. 

ELSE  IF  (FUN.EQ.  'AS  I NH '  )  THEN 

ARG=ABS(ARG) 

AP=AL0G(ARG+SQRT(ARG*ARG+1) ) 

IF  (AP.LT.O)  THEN 
AP=-AP 

END  IF 
END  IF 

RETURN 
END 


£**************************************** 
SUBROUTINE  PF I  X ( INF , POST ,  I P , PP ) 

C 

This  subroutine  transforms  the  infix  expression  produced 
by  the  subroutine  CONVERT  to  postfix  notation  using  the 
push-down  stack  method. 


C 

c 


IMPLICIT  INTEGER*2  (I-N) 

INTEGER*2  PP 

CHARACTER* 1  POST ( 18, 14), INF (18, 14) , STACK ( 30) 

Initialize  the  stack  pointer  K  and  the  pointer  PP  of  the 
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C      array  holding  the  created  postfix  exoression. 
C 

K  =  0 

PP  =  0 

c 

C      For  each  element  of  the  infix  expression, 
C 

DO  1  =  1,  IP 
C 

C      If   the   first  character  of  the  element  is  letter  or  "[" 
C     place  it  on  the  generated  postfix  exoression. 
C 

IF  ( ( INF( I , 1) .GE. ' A' .AND. INF( I , 1) . LE . '  Z' ) .OR. INF (1,1) 
1        EQ. ' [ ' )  THEN 
PP=PP+i 
DO  J=l, 14 

POST(PP, J)=INF( I ,J) 
END  DO 

C      Else  if   the   first   character   is   a  number  or  "."  then 

C     place  it  on  the  generated  postfix  exoresion. 

C 

ELSE  IF  ( (INF (1,1) .GE. '0' .AND. INF (1,1) . LE . '9' ) .OR. 
1  INF (I ,1) .EQ. ' . ' )  THEN 

PP=PP+1 
DO  J=l,14 

POST(PP,J)=INF( I, J) 
END  DO 

C      Else   if   the   element   is   "+",   which   has   the  lowest 

C      priority  of  operators, 

C 


ELSE  IF  (INF( 1,1) .EQ. '+' )  THEN 


C  if  the  stack  is  not  empty  and  the  topmost  element  is  not 

C  "(",  pop  the   stack  and  place  the  element  on  the  postfix 

C  expression,   push   the   next    element    of    the   infix 

C  expression  into  the  stack. 

IF  (K.NE.O .AND.STACK(K) .  NE  . ' ( ' )  THEN 
PP=PP+1 
POST(PP,l)=STACK(K) 

K  =  K-1 
END  IF 
K  =  K+1 
STACK(K)=INF( 1,1) 

C      Elseifthe  element  is  "-", 

ELSE  IF  ( INF( I , 1) .EQ. ' - ' )  THEN 

C      if  the  next  character  of  the  same  element  is  a  number  or 
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C  "[",  which  means  that  the  "-"  is  the  symbol  of  the 
C      subtraction,  place  the  element  in  the  postfix  expression. 

IF  ( ( INF ( I , 2 ) . GE .  *  0 '  . AND . I NF ( I , 2 ) . LE .  ' 9 '  ) . OR . 
1  INF( I , 2) .EQ. ' [ ' )  THEN 

PP=PP+1 
DO  J=l, 14 

POST(PP, J)=INF( I , J) 
END  DO 

C  Else  the  second  element  is  a  letter,  also  place  it  on 
C      the  postfix. 

ELSE  IF  ( INF( I , 2) . GE . ' A' . AND. INF( I , 2 ) . LE . ' Z' )  THEN 
PP=PP+1 
DO  J  =  l, 14 

POST(PP, J)=INF( I ,J) 
END  DO 

C  Else,  if   the  stack  is  not  empty  and  the  topmost  element 

C  of  the   stack   is   not  "(",  place  the  topmost  element  of 

C  .  the   stack   on   the   postfix  and  push  into  the  stack  the 

C  next  element. 

ELSE 

IF  (K.NE.O.AND.STACK(K) . NE . ' ( ' )  THEN 
PP=PP+1 

POST(PP, 1)=STACK(K) 
K=K-1 
END  IF 
K  =  K+1 

STACK (K)= INF ( 1,1) 
END  IF 

C      If  the  next  element  is  "*"  or  "/", 

ELSE  IF  ( INF( I , 1) .EQ. ' *\ .OR. INF( I , 1) . EQ . ' /' )  THEN 

C      if  the  topmost  element  of  the  stack  is  an  operator  with 
C      lower  priority  ("+","-")  or  "(",  push  it  into  the  stack, 

I F  ( STACK ( K ) . EQ . ' + ' . OR . STACK ( K ) . EQ . ' - ' . OR . STACK ( K ) . 
1  EQ. ' ( ' )  THEN 

K  =  K+1 
STACK(K)=INF( 1,1) 

C  else  until  the  stack  is  empty  or  the  "("  delimiter  is 
C  encountered,  pop  the  stack  and  place  the  operators  on 
C      the  pos'tfix  expression. 

ELSE 

DO  WH I LE ( K . NE . 0 . AND . STACK ( K ) . NE . ' ( ' ) 
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pp=pp+l 

POSTf??, 1 )= STACK' K) 
K=K-1 
END  DO 
K=K+1 

STACK ( K)= INF ( 1,1) 
END  IF 

C      If  the  next  element  is  of  hihger  priority  ("~"),  push  it 
C      into  the  stack. 

ELSE  IF  ( INF( I , 1) .EQ. ' ~' )  THEN 
K=K+1 
STACK(K)=INF( 1,1) 

C      If  it  is  "(",  also  push  it  into  the  stack. 

ELSE  IF  ( INF( I , 1) .EQ. ' ( ' )  THEN 
K=K+1 
STACK (K)=INF( 1,1) 

C     But   if   it   is   a   ")",   pop   the   stack   and  place  the 
C     operators  on  the  postfix  until  the  " ( "  is  encountered. 

ELSE  IF  ( INF( I , 1) .EQ. ' ) ' )  THEN 
DO  WHILE(STACK(K) . NE . ' ( ' ) 
PP=PP+1 

POST(PP,l)=STACK(K) 
K=K-1 
END  DO 
K=K-1 
END  IF 
END  DO 

if  the  stack  is  not  empty,  pop  it  until  is 


c 

At   the   end   if 

the  sta 

c 

empty. 

IF  ( K . NE . 0 )  THEN 

DO  WHILE(K.NE. 

.0) 

PP=PP+1 

POST(PP, 1)= 

=STACK(K 

K  =  K-1 

END  DO 

END  IF 

RETURN 

END 

c************************************************************* 

SUBROUTINE  EVAL ( LOGOLD , POST , RES , PP , INDEX , NC , JK , NCOL , 

1  •       X,FUN,ARG,  I  ERR) 

C*********************:*  *************************************** 
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c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 


This  subroutine  is  used  10  evaluate  a  postfix  expression 
using  the  push-down  stack  technique  . 


ARGUMENTS 
LOGOLD  : 

POST    : 

RES     : 
PP      : 

INDEX   : 


NC 

JK 

NCOL 
X 
FUN 

ARG 

I  ERR 


The   direct   access   file   containing   the  data 

before   any   transformation.   The   same  file  is 

used  to  store   the   data   after  transformations 

have  been  performed  to  them. 

Two   dimention   array    storing    the    postfix 

expres  ison . 

The  result  of  the  expression. 

The   number   of    elements    in    the    postfix 

express  ion . 

Pointer   marking   the   end  of  mnemonic  names  in 

the  array  (COLMNE)  that  stores  column  mnemonics 

and  transformations. 

The  index  of  the  array  COLMNE. 


The  number  of  columns 


the 


f unct ions 


Array   storing   the   name   of 

contained  in  an  expression. 

The  argument  of  the  function. 

Flag  indicating  invalid  function  arguments  or 

division  by  zero. 


'************************************************************* 


C 

c 


IMPLICIT  INTEGER*2  (I-N) 

INTEGER*2  NC , PP , INDEX , POINT , CN 

REAL* 4  STACK (24) , X(128) , 0P1 , 0P2 , OP , RES , R , ARG , AP 

CHARACTER* 1  POST ( 18, 14) , VAL ( 14) ,DUM( 14) ,FUN( 5) ,COL( 3) , 

1  CONS  (14)  ,  FUNK  5) 

CHARACTER* 5  FUN5 
EQUIVALENCE  ( FUN5 , FUN1 ( 1 ) ) 

IERR=0 
L=l 

For  each  element  of  the  postfix  expression. 

DO  I=1,PP 

If  the  element  is  a  letter, 

IF  (POST( I , 1) .GE. ' A' .AND. POST ( I , 1) . LE . ' Z' )  THEN 
J=l 

Store  until  the  "["  is  encountered  the  characters  of  the 
function  name  in  FUN. 


DO  WH I LE ( POST ( I , J ) . NE . ' [ ' ) 

FUN(J)=POST( I , J) 

J=J  +  1 
END  DO 
JA=J-1 
IJ  =  0 
DO  WHILE  (JA.LT. 5) 

IJ=IJ+1 

JA=JA+1 

FUN1(IJ)='      ' 
END    DO 
JA=0 
DO    WHILE ( IJ.LT. 5) 

IJ=IJ+1 

JA=JA+1 

FUNK  IJ)=FUN(JA) 
END    DO 
J=J  +  1 
KA=1 

C  Store  until  "]"  is  encountered  the  numbers 

C  contained  between  the  brackets  and  representing 

C  column  number  in  array  COL. 

DO  WH I LE ( POST ( I , J ) . NE . * ] ' ) 

COL(KA)=POST( I , J) 

KA=KA+1 

J=J  +  1 
END  DO 

C  Decode  the  characters  of  COL  to  obtain  the  number 

C  of  column. 

DECODE( 3, 100, COL)  CN 
10  0  FORMAT  (  KKA-1>) 

C  Using  the  uncoded  column  number  CN  assign  the  value 

C  of   the   corresponding   column    as  argument  to  the 

C  function. 

ARG=X(CN) 

C  Compute  the  value  of  the  function. 

CALL  COMP(FUN5,ARG, AP ,  I  ERR) 
C  Push  the  result  into  the  stack. 

STACK (L)=AP 

L  =  L  +  1 
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C        Else  if  the  current  element  of  the  postfix  is  "[", 

ELSE  IF  (?OST( I , 1) .EQ. * [ ' )  THEN 
J  =  2 
KB=1 

C  Place  the  numbers  (characters)  contained  between 

C  the  brackets  in  array  COL. 

DO  WH I LE ( POST ( I , J )  .  NE  .  '  ]  '  ) 

COL(KB)=POST( I , J) 

J=J+1 

KB=KB+1 
END  DO 

C  Decode   the   content   of  COL,  obtain  the  number  of 

C  colun  CN  and  push  into  the  stack  the  corresponding 

C  column  value. 

DECODE (3, 2 0  0, COL)  CN 
200  FORMAT ( K KB- 1>) 

STACK(L)=X(CN) 

L  =  L+1 

C        Else   if  the   current  element  of  the  post  is  a  number 
C        or  **.", 

ELSE  IF  ( (POST( I ,1) .GE. ' 0 ' . AND . POST ( I , 1) . LE . ' 9' ) . 
1  OR. POST ( I , 1) .EQ. ' . * )  THEN 

J  =  l 
KC=1 

C  store  the   characters  of  this  element  in  the  array 

C  CONS . 

DO  WHILE ( (POST( I , J) . GE . ' 0 ' .AND. POST ( I , J) .LE. 
1  ' 9'  )  .OR. POST ( I , J)  .EQ.  '  .  '  ) 

CONS(KC)=POST( I, J) 

J  =  J+1 

KC=KC+1 
END  DO 
POINT=0 

C  Find  the  position  of  ".", 

DO  IK=1,KC-1 

IF  (CONS( IK) .EQ. ' . ' )  THEN 

POINT=IK 
END  IF 
END  DO 

C  If  no  point  exists  then  add  a  point 
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IF  (POINT.EQ.O)  THEN 
CONS(KC)= ' . ' 

C  decode  the  number  and  push  it  into  the  stack 

DECODE (KC, 500 , CONS)  OP 
500  FORMAT(F<KC-1>.0 ) 

STACK (L)=OP 
L  =  L+1 

C  else  decode   the  representation  of  a  real  and  push 

C  it  into  the  stack. 

ELSE 

DECODE (KC-1, 300, CONS)  OP 
300  FORMAT(F<KC-2>.<KC-l-POINT>) 

STACK (L)=OP 

L  =  L+1 
END  IF 

C  If   the   element   is   "-"   then    examine   the  second 

C  character  to  determine  if  represents  subtraction  or  a 

C  negetive    value   is  present.  In  the  first  case  treat 

C  the  "-"  as  the   other   operators   while  in  the  second 

C  negate  the  following  the  sign  value. 

ELSE  IF  (POST( I , 1) .EQ. ' -' )  THEN 

IF  (POST( I , 2) .GE. ' 0 ' .AND. POST ( I ,2) .LE. ' 9' )  THEN 
J  =  2 
KD=1 

DO  WH I LE (  ( POST ( I , J )  . GE .  ' 0  *  . AND . POST ( I , J ) . LE . 
1  ' 9' ) .OR. POST ( I, J) .EQ. ' . ' ) 

CONS(KD)=POST( I , J) 
J=J  +  1 
KD=KD+1 
END  DO 
POINT=0 
DO  IK=2,KD-1 

IF  (CONS( IK) .EQ. ' . ' )  THEN 

POINT=IK 
END  IF 
END  DO 

IF  (POINT.EQ.O)  THEN 
CONS(KC)=*  . ' 
DECODE(KD,600/CONS)  OP 
600  FORMAT(F<KD-1>.0) 

STACK(L)=OP 
L  =  L+1 
ELSE 

DECODE (KD- 1,400, CONS)  OP 
400  FORMAT! F<KD-2>. <KD-l-POINT>) 
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STACK (L) =-0P 

L  =  L+1 
END  IF 
ELSE  IF  (?OST( I , 2) . SQ . ' [ ' )  THEN 
J  =  3 
KE=1 
DO  WH I  LE  (  POST  (  I  ,  J  )  .  NE  .  '  ]  '  ) 

COL(KE)=POST( I , J) 

J  =  J  +  1 

KE=KE+1 
END  DO 

DECODE ( 3 ,80  0, COL)  CN 
800  FORMAT  (  KKE-1>) 

STACK (L)=-X(CN) 
L  =  L+i 
ELSE  IF  (POST( I ,2) . GE . ' A' . AND . POST ( I , 2) . LE . ' Z* 
1  THEN 

J  =  2 
DO  WH I LE ( POST ( I , J ) . NE . ' [ ' ) 

FUN( J)=POST( I ,J) 

J=J  +  1 
END    DO 
JA=J-1 
IJ  =  0 
DO    WHILE     (JA.LT. 5) 

IJ=IJ+1 

JA=JA+1 

FUN1(IJ)='     ' 
END    DO 
JA=0 
DO   WHILE( IJ.LT.5) 

IJ=IJ+1 

JA=JA+1 

FUNK  IJ)=FUN(JA) 
END    DO 
J=J  +  1 
KF=1 
DO    WH I LE ( POST ( I , J  )  .  NE  .  '  ]  '  ) 

COL(KF)=POST( I , J) 

KF=KF+1 

J=J  +  1 
END    DO 

DECODE ( 3 ,700 , COL)  CN 
700  FORMAT  (  KKF-1>) 

ARG=X(CN) 

CALL  COMP(FUN5, ARG , AP ,  I  ERR) 
STACK(L)=-AP 
L  =  L+1 
ELSE 

L  =  L-1 

OP2=STACK(L) 
L  =  L-1 
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0P1=STACK(1 

R=0?i-0?2 
STACK (L)=R 
L  =  L+1 


C         If  the  element  is  an  operator,  pop  the  two  topmost 
C        elements  of  the  stack,  apply  the  operator  to  them 
C        and  push  the  result  into  the  stack. 

ELSE  IF  (POST( I , 1) .EQ. ' +' .OR. POST ( I , 1) . SQ . ' *' .OR 
1  POST( I ,1) .EQ. ' /' .OR. POST ( I , 1) . EQ . ,/v  ' )  THEN 

L=L-1 

OP2=STACK(L) 
L  =  L-1 

OPl=STACK(L) 
IF  (POST(l ,1) .EQ. '+' )  THEN 

R=OPl+OP2 
ELSE  IF  (POST ( 1,1) -EQ. '*' )  THEN 

R=OPl*OP2 
ELSE  IF  (POST( I , 1) .EQ. ' /' )  THEN 
IF  (OP2.NE.0)  THEN 

R=OPl/OP2 
ELSE 

IERR=2 
RETURN 
END  IF 
ELSE  IF  (POST( I ,1) .EQ. ' ~* )  THEN 

R=OPl**OP2 
END  IF 
STACK(L)=R 
L  =  L+1 
END  IF 
END  DO 
L  =  L-1 
RES=STACK(L) 
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RETURN 
END 


SUBROUTINE  DISDAT(LEC,  IMP , NCOL , NROW ,  I  OPEN,  I  CLOSE) 

£x*xxx*x*xxxx*xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 

c 

C     This   subroutine   is   used  for  the  display  of  all  or  any 

C     user  assigned  part  of  the  data  file. 

C 

C   ARGUMENTS  : 

C 


C  LEC,  IMP 

C  NCOL 

C  NROW 

C  IOPEN 


Input/Output  logical  numbers  for  terminal. 

Number  of  columns. 

Number  of  rows. 

If  equal  to  1,  assign  and  open  the  direct-access 
C  data  file  and  output  display. 

C   ICLOSE    :  If  equal  to  1,  close  the  direct-access  data  file 
C 

(^xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 

IMPLICIT  INTEGER*2  (I-N) 
BYTE  STRING(72) ,FMT1(72) , FMT2(72) 
CHARACTER* 7  MODCOL , MODROW 
CHARACTER*72  FMTC1,FMTC2 
CHARACTER* 4 5  DEVDI R , NAME* 10 

REAL*4  X(128) 

DIMENSION  NOCOL( 2  56) ,NOROW(2048) 

EQUIVALENCE  ( FMTC1 , FMT1 ( 1) ) , ( FMTC2 , FMT2 ( 1 ) ) 

DATA  LOGOLD, IMP2/2 , 7/DEVDI R , NAME/ ' DUAO  :',*   '/ 
DATA  MODCOL/ ' columns ' /MODROW/ *  rows ' / 
DATA  FMTC2/' (16,   F14.  6) V 

C     Declare  LOGOLD  unit  data  file. 

IF  ( IOPEN. EQ.l)  THEN 

NBYTES=NCOL*4 

WRITE( IMP, 100 ) 

CALL  F I CH (  ' 0  6  9 '  , LOGOLD , 1 , DEVD I R , NAME , NROW , NBYTES ,  1 , 
1  'DIRECT' ,LEC, IMP) 

C        Display  output  unit  attribute. 

CALL  ENSORT(LEC, IMP, IMP2) 
END  IF 
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C      Display  conditions  for  columns. 

CALL  ANADIS(LEC, IMP,NC0L*2 , NCOL , NOCOL , NBCOL , MODCOL) 

IF(NBCOL.EQ.O)  RETURN 

C     Display  conditions  for  rows. 

CALL  ANADIS(LEC, IMP,NROW   ,NROW, NOROW,NBROW, MODROW) 

IF(NBROW.EQ.O)  RETURN 

NOUT=0 

C      Change  FORMATS  for  output. 

CALL  FORM(LEC, IMP, FMTC1 , FMT2 , N , II) 

DO  WHILE  (NOUT. LT. NBCOL) 
IBEG=NOUT+l 
IEND=IBEG+N-1 
IF ( IEND.GT. NBCOL)  THEN 

IEND=NBCOL 
END    IF 
C  For    columns. 

M=IEND-IBEG+1 
ENCODE(2,200  ,  FMTK07)  )    M 
C  For    underlining. 

M=5+M*I1 

ENCODE(2,2  0  0,FMT1( 25) )    M 

WRITE ( IMP2,FMT1)  (NOCOL(J)  , J=IBEG,  I  END) 
1  =  1 
DO  WHILE( I .LE.NBROW) 

READ(LOGOLD*NOROW( I ) ) (X(J) , J=l,NCOL) 

WRITE ( IMP2,FMT2)  NOROW( I )  ,  (X(NOCOL(J)  )  ,J=IBEG,  I  END 
1  =  1  +  1 
END  DO 
NOUT = NOUT +N 
END  DO 

IF  ( ICLOSE.EQ. 1)  CLOSE  (LOGOLD) 
RETURN 

C      Formats. 

100    FORMAT (//4X, 'Name  of  the  existing  data  file  :') 
200      F0RMAT(I2) 

END 


<2*  ***********************************************************  * 
SUBROUTINE  FORM(LEC, IMP , FMTC1 , FMT2 , N, II) 

Q*  *************  .  *********************************************** 

c 
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C      Permits   the   user   to   determine  the  format  of  the  dat 

Cthat  will  be  displayed. 

C 

IMPLICIT  INTEGER*2  (I-N) 

BYTE  FMT(72) ,FMT2(72) ,STRING(72) 
CHARACTER* 7 2  FMTC,FMTC1 

EQUIVALENCE  ( FMTC , FMT ( 1 ) ) 

DATA  FMTC  /' (//7X,    (   X,I3,   X) /1X, 75 ( \-\ ) /) * / 

C     Because  compiler  does  no  admit  quotes  inside  the  chain, 
C     they  are  changed  by  'V  and  substituted  after. 

FMT(28)=039 
FMT(30)=033 

WRITE( IMP, 100 ) 
100    FORMAT(/4X, ' The  normal  format  is      :  nnnnnnn . nnnnnn ' 
1        //'$'  3X, 
2 ' To  modify  it  assign  your  format  (ex.  nnn.nn)  <CR>  :') 

C     Read  the  user  assigned  FORMAT. 

READ(LEC,200)  STRING 
200    F0RMAT(72A1) 
IPOINT=0 
1  =  1 
DO  WHILE(STRING( I ) . NE . *  ') 

IF  (STRING( I ) .EQ. ' . ' )  IPOINT=I 
1  =  1  +  1 
END  DO 

C     Data  format. 

IF  (I.EQ.1)  THEN 
C        For  FORMAT ( 5F14 .6)  for  Data. 
11  =  14 
IPOINT=8 
ELSE 
C        For  general  format  for  Data. 
IF  ( IPOINT.EQ.O )  THEN 
IPOINT=I 
11=1 
ELSE 

11=1-1 
END  IF 
END  IF 

'   ENCODE(2,300,FMT2(08) )  II 
30  0    F0RMAT(I2) 
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N=70/I1 

ENCODE! 2 , 300 , FMT2 ( 05) )  N 
FMT2(07)='F' 
FMT2(10)  =  '  .  ' 
FMT2(13)  =  *  )  ' 

1  =  11- I  POINT 

ENCODE(2,300,FMT2( 11) )  I 
DO  1=14,72 

FMT2(I)='  ' 
END  DO 

Format  for  Title. 

I3=( 1 1-3 ) /2 

I  4= 1 1- (  13  +  3) 

IF  (I3.NE.0)  THEN 

ENCODE(2, 3  0  0,FMT( 10) )  13 
ELSE 

FMT(12)='  ' 

FMT (13)='  ' 
END  IF 
IF  ( I  4 . NE . 0 )  THEN 

ENCODE(2, 30  0, FMT (17) )  14 
ELSE 

FMT(16)='  ' 

FMT(19)='  ' 
END  IF 

FMTC1=FMTC 

RETURN 

END 


q*  ***********************************************************  * 

SUBROUTINE  SEEDAT(LEC,  I  MP , NCOL , NROW ,  I OPEN,  I  CLOSED 
q*  ***********************************************************  * 

C 

Input/Output  logical  numbers  for  terminal. 

Number  of  columns. 

Number  of  rows. 

If  equal  to  1,  assign  and  open  the  direct-access 

data  file  and  output  display. 

If  equal  to  1,  close  the  direct-access  data  file 


LEC,  IMP 
NCOL 
NROW 
IOPEN 

ICLOSE 


************************************************************** 


IMPLICIT  INTEGER*2  (I-N) 
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CHARACTER* 4 5  DEVOIR, NAME* 10 

CHARACTER* 7  MODCOL , MODROW 

BYTE  STRING  (30) 

REAL*4  X(128) ,Y(32) 

DIMENSION  NOCOL(2  5b) , NOROW( 2  0  48 ) 

DATA  LOGOLD, IMP2/2 , 7/DEVDI R , NAME/ ' DUAO  :','   '/ 

1GOLD/12  34  5.6  78/IFOU/0/ 

DATA  MODCOL/ ' columns ' /MODROW/ ' rows ' / 

C     Declare  LOGOLD  unit  data  file. 

IF  (IOPEN.EQ.l)  THEN 

NBYTES=NCOL*4 

WRITE( IMP, 100) 

CALL  FICH(  ' 069 '  , LOGOLD, 1 , DEVDI R , NAME , NROW , NBYTES  ,  1  , 
1  'DIRECT' ,LEC, IMP) 

C        Display  output  unit  attribute. 

CALL  ENSORT(LEC, IMP, IMP2) 
END  IF 

C     Display  conditions  for  columns. 

CALL  ANAD I S ( LEC ,  I MP , NCOL *  2 , NCOL , NOCOL , NBCOL , MODCOL ) 
IF(NBCOL.EQ.O)  RETURN 

C     Display  conditions  for  rows. 

CALL  ANADIS( LEC, IMP, NROW   , NROW , NOROW , NBROW , MODROW ) 
IF(NBROW.EQ.O)  RETURN 

NB=0 

C      Flags   for   evental   continuation   lines   if   last 
C     character=  '  ,  '  . 

IWRIT=1 

ICONT=l 
C 

c 


DO  WHILE  ( ICONT.EQ. 1) 

ICONT=0 

Input  string 

IF  (IWRIT.NE.0)  WRITE( IMP, 600 

READ  (LEC, 70  0)  STRING 

IWRIT=0 

Analysis  of  the  string. 
NCAR=80 
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DO  WHILE  (STRING(NCAR) .EQ. '   ' 
NCAR=NCAR-1 

END  DO 

IF  ( STRING (NCAR) . EQ . ' , ' )  THEN 

ICONT=l 

STRING(NCAR)= '   ' 
ELSE 

NCAR=NCAR+1 
END  IF 
IGOLD=0 
IBEG  =1 


1=0 

DO  WHILE  (I .LT.NCAR) 
1  =  1  +  1 

'GOLD'  can  be  any  letter. 

IF  ( ( STRING ( I ) .GE. ' A' .AND 

(STRING( I ) .GE. ' a' .AND 

IF  (IGOLD.EQ.0)  THEN 


STRING! I 
STRING ( I 


LE. ' Z' ) .OR. 
LE  .  '  z  '  )  )  TH3 


WRITE( IMP, 200) 
READ  (LEC,30  0) 
IF  (GOLD2.NE.0 

END  IF 

NB=NB+1 

Y(NB)=GOLD 


GOLD 

GOLD2 

)  GOLD=GOLD2 


DO  WHILE 

1  =  1  +  1 
END  DO 
ELSE 


STRING( I 
STRING( I 


.NE. 
.NE. 


. AND . I . LT . NCAR . AND 


IPOINT=0 
DO  WHILE 


END 


STRING( I ) .NE. 
STRING! I ) .NE. 
IF(STRING( I ) .EQ. ' 
1  =  1  +  1 
END  DO 
IEND=I-1 
Number  :  nnn 
IF  ( IPOINT.EQ.0)  THEN 
STRING! I )=' . ' 
I  POINT    =1 
I  END      =  I 
END  IF 

I1=IEND-IBEG+1 
I2=I1-IP0INT+IBEG-1 
NB=NB+1 

DECODE! 11,40  0 , STRING! IBEG) ) 
END  IF 
IBEG=I+1 
DO 


. AND . I . LT . NCAR . AND . 


)  IPOINT=I 


Y(N3 
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c 
c 


END  DO 


K  =  0 

DO  WHILE(K.LT.NBROW) 
K  =  K  +  1 

READ ( LOGOLD ' NOROW ( K ) ) ( X ( L ) , L=l , NCOL ) 
DO  L=l,NBCOL 
DO  N=1,NB 

IF(X(NOCOL(L) ) .EQ.Y(N) )  THEN 

INDEX=NCOL* (NOROW(K) -1 ) +NOCOL( L) 
IFOU=IFOU+l 

WRITE( IMP 2, 50  0) I FOU , INDEX , NOCOL ( L ) , NOROW(K) , 
1  Y(N) 

END  IF 
END  DO 
END  DO 
END  DO 

IF*  ( ICLOSE.EQ. 1)  CLOSE  (LOGOLD) 
RETURN 

C      Formats. 

100    FORMAT (//4X, 'Name  of  the  existing  data  file  :') 

200    FORMAT(/4X, 'Missing  value  "gold"  number  is  :  ',F9.3// 

1' $', 3X, "Change  or  RETURN  :  ') 
300    FORMAT (F 18  .8  ) 
400    F0RMAT(F<I1>.<I2>) 
500    FORMAT(//I6,3X, ' Index  :',I6,'  , Column  :  ',14,'  ,Line  :', 

116, '  --  Value  : ' ,F14.6) 
600    FORMAT(/* $ ' , 3X, 'Data  to  be  retrieved  (real  or  "gold")  :  ') 
700    FORMAT (80A1) 

END 


SUBROUT I NE  ANAD I S ( LEC , I MP , MAXD I M , N , NOCORO , MELEM , MODE ) 

C   This  subroutine  ANAD IS  analyses  the  assignement  for  columns 
C   or  rows  through  a  string  given  by  the  user  in  four  modes. 


C 
C 

c 
c 


Examples  : 

1) .    *  or  all  or  ALL 
2)  .    3:12 


Comments  : 

take  all  columns  or  rows. 

take  ■  all   columns  or    rows 

between   the   lower  and  upper 
boundar  ies . 
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C   3 

C 

C 

C   4 

C   5 


1,3,8,2,1 


1,3,  12:15,20:27,31 


take   successively   the   named 
columns   or  rows,  even  repeted 
in  the  given  order. 
take  a  single  column  or  row. 

mixing  modes  2).  and  3). 


c 

ARGUMENTS 

c 

LEC  and  IMP 

c 

MAXD I M 

c 

N 

c 

c 

NCORO 

c 

NELEM 

c 

c 

MODE 

c 

c 


Logical  numbers  for  input/output  keyboard. 

Maximum  dimension  for  NOCOROl ) . 

Maximum  number   of   columns   (NCOL)   or   rows 

( NROW ) . 

Nos.  of  the  displayed  columns  or  rows. 

Total   number  of  elements  to  take  (columns  or 

rows ) . 

Represents   a  chain  of  characters  :  'columns' 

or  ' rows    ' . 


************************************************************* 

IMPLICIT  INTEGER*2  (I-N) 
DIMENSION  NOCORO(MAXDIM) 
CHARACTER* 7  MODE 
BYTE  STRING(80) 
Initial izat  ion . 
NELEM=1 


C 

c 


c 
c 


Flags   for   evental   continuation   lines 

character= ' , ' . 

IWRIT=1 

ICONT=l 


if 


ias 


DO  WHILE  ( ICONT.EQ. 1 
ICONT=0 


NBEG=0 
NCAR=0 
IBEG=1 
ISER=0 

Input  string. 

IF  (IWRIT.NE.O)  WRITE( IMP, 100)  MODE 

READ  (LEC, 200)  STRING 

IWRIT=0 
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C      If  empty  string. 
c      ___ 

IF  (STRING(l) .EQ. '  ' )  THEN 

NELEM=0 

RETURN 
END  IF 

C      If  all  colums  or  lines  are  displayed.  (*  or  any  letters 
c      

IF  (STRING(l) .EQ. ' *' .OR. 

1  (STRING( 1) .GE. ' A' .AND.STRING( 1 ) . LE . ' Z ' ) . OR . 

2  ( STRING ( 1) .GE. ' a' . AND . STRING ( 1 ) . LE . ' z' ) )  THEN 

DO  I  =  1,N 

NOCORO( I)=I 
END  DO 
NELEM=N 
RETURN 
END  IF 

C      String  analysis. 

1  =  1 

DO  WHILE  (STRING( I ) . NE . '   ') 

C        Control  of  string  validity. 

IF( (STRING( I ) .GE. ' 0 ' .AND. STRING ( I ) . LE . ' 9 ' ) . OR . 
1      (STRING(I) .EQ. ' : ' .OR  . STRING ( I ). EQ .',*) )  THEN 
ELSE 

NELEM=0 

WRITE( IMP, 400) 

RETURN 
END  IF 

C        If  between  lower  and  upper  boundaries  (ex:  3:8). 
c 

C        or/and  if  list  of  numbers  (ex:  2,5,8,3). 
c        

IF  (STRING( I ) .EQ. ' , ' .OR.STRING( I ) . EQ . ' : ' )  THEN 
IEND=I-1 

DECODE (NCAR, 3  0  0,STRING( I  BEG)  )  NOCORO ( NELEM ) 
IF  ( NOCORO ( NELEM ) . GT . N )  THEN 

WRITE( IMP, 500)  N 

NELEM=0 

RETURN 
END  IF 
IF  (STRING(I) .EQ. ' : ' )  THEN 

ISER=1 
ELSE 
IF  (STRING( I ) .EQ. ' , ' )  THEN 

IF  (ISER.EQ.l)  THEN 
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NBEG=NCCORO ( NELEM- I ) + 1 
NEND=NOCORO ( NELEM ) 
NELEM=NELEM-1 
DO  J=NBEG,NEND 
NELEM=NELEM+1 
NOCORO(NELEM) =J 
END  DO 
ISER=0 
END  IF 
END  IF 
END  IF 

NCAR=0 

NELEM=NELEM+1 
IBEG=I    +1 
ELSE 

NCAR=NCAR+1 
END  IF 
1  =  1  +  1 
END  DO 

C      If  the  number  of  delimiters  is  zero 

C     Just  one  column  or  row  is  displayed  (ex  :  4). 

c      

I F  ( NELEM . EQ . 1 )  THEN 

1  =  1-1 

DECODE(    I ,300 ,STRING( IBEG) )  NOCORO(l) 

IF  ( NOCORO ( 1) .GT.N)  THEN 

WRITE( IMP, 500)  N 

NELEM=0 

RETURN 
ELSE 
END  IF 
ELSE 

C        Analyse  string  residual. 
c        

DECODE(NCAR, 300 ,STRING( IBEG) )  NOCORO ( NELEM ) 
IF  (NOCORO (NELEM) .GT.N)  THEN 
WRITE( IMP, 50  0 )  N 
NELEM=0 
RETURN 
ELSE 
C  For  continuation  line,  if  last  character  is 

IF  ( NOCORO ( NELEM ) . EQ . 0 )  THEN 

ICONT=l 
ELSE 

IF  (ISER.EQ.l)  THEN 

NBEG=NOCORO ( NELEM- 1 ) + 1 
NEND=NOCORO ( NELEM ) 
NELEM=NELEM-1 
DO  J=NBEG,NEND 
NELEM=NELEM+1 
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NOCORO(NELEM)=J 

END  DO 

END  IF 


END  IF 
END  IF 
END  IF 


C 
C 


100 
200 
300 
400 

500 


END  DO 

RETURN 

Formats . 

FORMAT(/' $', 3X, 'Assign  no(s).  of  ',A7,'  : 

FORMAT ( 8 0A1) 

FORMAT  (  KI>) 

FORMAT(4X//'  INVALID  INPUT  !! 

1  (must  be  numerical  AND/OR   " , "  or  ":")') 

FORMAT (4X//'  NUMBER  EXCEEDS '  ,  I  6 ,  '   !!') 


END 


************************************************************** 

SUBROUT I NE  F I CH ( NNN , NLOG I C , I AUT , DEVD I R , NAME , NENR , MBYTES , 

1  ISTAT, ACCESS, LEC, IMP) 

************************************************************ 


C* 

c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 


This  Subroutine  permits  to  Open,  within  a  FORTRAN  Program 
at  Run  Time,  specific  Files  named  ' FORnnn . DAT ' f or 
calculation  and  deletion  or  general  Files  named 
'file  name.ext'.  These  Files  may  be  used  for  Unformatted 
Direct  Fixed  Access  or  Formatted  Sequential  Variable  Access 

ARGUMENTS  : 

'NNN'   Can   be   3   {0,9}   numerical   equivalent   characters 
otherwise,  a  Key  (ex:  '012',  '326',  a  key  :  'G13',  'TT2') 
If  NNN= '  ',  the  File  will  be  named  as  the  content  of  NAME. 
If   not,    the   File   will   be   named   as  'FORnnn.DAT',  ex: 
' FOR012 .DAT' . 


NLOG  I C 
I  AUT 

DEVD I R 


Logical  Unit  number. 

If  IAUT.NE.0,  Input  the  3  characters  Key,  the  File 
is  named  as  'FORkey.DAT',  or  Input  NAME.  If  IAUT=0, 
the  File  is  named  as  'FORNNN.DAT',  or  'name' 

If  '  ',   ask  for  Device  and  Directory-Subdirectory 
names.  If  * DUA0 : '  or  ' DUA0 :[ DIRECTORY . SUBdi r ] '  for 
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NAME 

NENR 
KBYTES 


ACCESS 

I  STAT 
INDX 


ex . ,  no  change . 

If  NNN=  '  ',  asks  by  Keyboard  the  name  of  the  File, 

when  IAUT,NE.O.  NAME  contents  up  to  10  characters. 

Maximum  records  number. 

Number  of  3YTES  per  Record,  If  UNFORMATED  Records, 
transformation  in  full  32  bits  Words,  MUST  be  a 
multiple  of  4  BYTES  (If  not,  BELL  rings,  a  message 
and  a  complementation  occur) 

If  'DIRECT'  :   DIRECT,  UNFORMATTED,  FIXED   records, 
otherwise  :  SEQUENTIAL, FORMATTED, VARIABLE  records. 


C 
C 

c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 

c 

C   Examples  : 
C 


If  ISTA=0 


'NEW ,  otherwise  :  'OLD' 


Associated  Variable  for  Unformatted  Direct  Access, 
not  a  dummy  argument,  it  will  be  auto-post- 
Incremen ted, COMMON  /INDEX/ INDX  must  be  present  in 
the  calling  program.  Be  CAREFULL,  INDX  is  common 
for  all  the  opened  files. If  no  COMMON  /INDEX/ INDX 
or  Using  another  integer  variable,  no  auto-post- 
Incrementat ion,  when  READ  or  WRITE. 


C 
C 

c 
c 
c 
c 
c 
c 

C      '  ' 

c 

C   Remark 
C 


NNN 

'nnn' 
'key' 


nnn 


IAUT 

0 
0 
0 
0 

1 
1 

Prior  i  ty 
present . 


NAME 


t   i 


' name .dat ' 


QUESTION 

None 

None 

None 

NAME 

•p 

KEY 

■p 

NAME 

-> 

RESULT 

FORnnn.DAT 
FORkey.DAT 
name . ext 
NAME 

FORkey.DAT 
NAME 


is   always   given   to 


nnn 


or 


Key 


q*  ***********************************************************  * 

C 

IMPLICIT  INTEGER*2  (I-N) 


C 
C 

c 


CHARACTER*  3  FOR , NNN , KEY , STAT , EXT*  4 , DEV*  5 , NAME  *  1 0 , 
1ACCESS*6,DIR*4  0,DEVDIR*4  5,DEDINA*5  5,3ELL*1 

COMMON  /INDEX/ INDX 

DATA  FOR, EXT/' FOR' , ' .DAT' /BELL/007/ 
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IF(DEVDIR.SQ. '   ' ) THEN 
C 

WR I TE ( I MP , 1 0  0 ) NLOG I C 
100    FORMAT (' $Dev ice  for  File', 13,'  (If  Default  :  <CR>  :  ') 

READ(LEC,20  0)DEV 
200    FORMAT (A5) 

WRITE( IMP, 300)NLOGIC 
300    FORMAT( ' $Directory  for  File', 13,'  (If  Default  :  <CR>)  :'] 

READ(LEC,400)DIR 
400    FORMAT (A40) 

DEVDIR=DEV//DIR 
C 

C 

c 
c 
c 


c 
c 
c 

c 
c 
c 


c 
c 


ELSE 

IF( IAUT.EQ.O )THEN 

IF(NNN.EQ. '  ' )THEN 

IF(NAME.EQ. '   * ) THEN 


WRITE ( IMP,50  0)NLOGIC 
500  FORMAT (' $Name  for  File', 13,'  :  ') 

READ(LEC, 60  0) NAME 
600  FORMAT(AIO) 

C 

c 
c 


ELSE 

END  IF 

DED I NA=DEVD I R//NAME 
GO  TO  1 


ELSE 

END  IF 

DEDINA=DEVDIR//FOR//NNN//EXT 
GO  TO  1 

ELSE 

IF(NNN.EQ. '   ' )THEN 

WRITE( IMP, 50  0 )NLOGIC 
READ(LEC, 60  0) NAME 
DEDINA=DEVDIR//NAME 
GO  TO  1 

ELSE   " 

WRITE ( IMP, 7  00)NLOGIC,NNN 
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700  FORMAT(/' $ ' ,3X, 

1  'Key  (xxx)  For  File  FORxxx.DAT  number1, 13, 

2  ',  (nnn=',A3,')  :  ') 
READ (LEC, 800) KEY 

800  FORMAT (A3) 

DEDINA=DEVDIR//FOR//KEY//EXT 
GO  TO  1 


C 

c 
c 


END  IF 
END  IF 
END  IF 


C 

C   Assign  File  to  a  logical  Unit. 

C 

1      IF( ISTAT.EQ.0)  THEN 

C 

c 
c 
c 


STAT='NEW 
ELSE 

STAT='OLD' 
END  IF 


C 

C   Control  the  Access  Mode  : 

C 


C 

C 


IF( ACCESS. EQ. 'DIRECT' ) THEN 
NMOT32=INT(NBYTES/4 ) 
I F ( MOD ( NBYTES ,  4  ) . NE . 0 ) THEN 


C 

C      If  a  message  wanted. 
C  WRITE( IMP, 900)BELL 

90  0  FORMAT (/ IX, Al,  '  ERROR  IN  RECORDS  I ZE  ARGUMENT, 

1         'MUST  BE  A  MULTIPLE  OF  4'/) 

NMOT3  2=NMOT3  2+l 

NBYTES=NMOT32*4 


C 
C 

c 


ELSE 

END  IF 

OPEN(unit=NLOGIC, name=DEDINA, status=STAT, 
laccess= ' DIRECT' , records i ze=NMOT32 , recordtype= 'FIXED' , 
2initialsize=NENR, form= 'UNFORMATTED' , 
3associatevariable= INDX) 

ELSE 
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c 
c 
c 


OPEN ( un i  t  =NLOG I C , n ame  =  DED I NA , s  t  a t us  =  STAT , 
laccess= ' SEQUENTIAL' , records i ze=NBYTES , 
2recordtype= ' VARIABLE '  , in  it  ialsize-NENR, form= ' FORMA' 

END  IF 

RETURN 

END 


'ED 


ARGUMENTS  : 


c*  ***********************************************************  * 
SUBROUTINE  EXSHEL ( X , NO , N , IND ) 

Q*  ***********************************************************  * 

c 

C   Subroutine   for  internal  and  address  calculation  sore  using 

C   the  Shell's   method   to  rank  elements  X  in  increasing  order 

C   and  modified  for  address  calculations. 

C 

C 

c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 

Q*  ***********************************************************  * 

c 

IMPLICIT  INTEGER*2  (I-N) 
C 

C   Elements  X  and  TEMP  can  be  declared  as-: 
C   INTEGER  *2  or  *4,  REAL  *4,  *8 ,  *16  , CHARACTER 
C 


X 

NO 

N 

IND 


Elements  to  sort. 

Address  calculation  for  the  rank. 

Number  of  elements  to  sort. 

If  >0  elements   are   ranged  in  increasing  order,  if 

not,  in  decreasing  order. 


Reference  :  Shell  Donald  L.  (1959)  :  "A  High-Speed  Sorting 
Procedure",  Comm  of  the  ACM,  vol.2,  July, 
p. 30-32. 


C 

1 

c 


REALM  X(N) ,TEMP 
DIMENSION  NO(N) 

NO ( I )  =  I 

M=N 
M=M/2 

DO  WHILE(M.GT.O ) 
DO  5  K=1,M 
NMM=N-M 

DO  4  I=K,NMM,M 
J=I 
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IPM=I+M 

TEMP   =  X( IPM) 

NOTEMP=NO( IPM) 

2  IF( IND.GE.O )THEN 

I F ( TEMP . GT . X ( J ) ) GO  TO  3 
ELSE 

I F ( TEMP . LE . X ( J ) ) GO  TO  3 
END  IF 
JPM=J+M 
X  (J+M)=X  (J) 
NO(JPM)=NO(J) 
J=J-M 
IF(J.GE.  DGO  TO  2 

3  JPM=J+M 

X(  JPM)=TEMP 
NO(JPM)=NOTEMP 

4  CONTINUE 

5  CONTINUE 

M=M/2 


C 
C 


END  DO 
RETURN 
END 


SUBROUTINE  EXSH1 ( X , NO , N , IND ) 

IMPLICIT  INTEGER*2  (I-N) 
INTEGER*2  X(N) ,TEMP 
DIMENSION  NO(N) 


c 

1 

NO ( I )  =  I 

c 

M=N 
M=M/2 

c 

DO  WHILE(M.GT.O) 
DO  5  K=1,M 
NMM=N-M 

DO  4  I=K,NMM,M 
J=I 

IPM=I+M 

TEMP   =  X( IPM) 
NOTEMP=NO( IPM) 

2 

'  IF( IND.GE. 0 )THEN 

IF(TEMP.GT.X( J) )GO 

TO  3 

ELSE 

IF(TEMP.LE.X(J) )GO 

TO  3 
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END  I? 

JPM=J+M 

X  (J+M)=X  (J) 

NO(JPM)=NO( J) 

J  =  J-M 

IF(J.GE.1)G0  TO  2 

3  JPM=J+M 

X(  JPM)=TEMP 
NO( JPM)=NOTEMP 

4  CONTINUE 

5  CONTINUE 

M=M/2 

END  DO 
C 

RETURN 
C 

END 

r************************************************************** 

SUBROUT I NE  ENSORT ( N I N , NOUT , NPR I NT ) 
p*  *****************************************************  ******* 

C 

C   This  subroutine  permits  Input/Output  modifications  or 

C   assignments  for  physical  Input  or/and  Output,  or/and  Print 

C   for  Devices  or  Files  within  a  FORTRAN  Program  or  Subroutine 

C 

C   ARGUMENTS  : 

C 

C  NIN  and  NOUT  are  the  respective  Logical  FORTRAN 

C  numbers  for  Input  and  Output  (for  Terminal 

C  in  general)  and  NPRINT  for  Print  (for  Printer 

C  in  general,  but  may  be  used  for  Terminal  Output 

C  or  Fi le  output ) . 

C 

C   SUBROUTINE  called  : 

C 

C  INOUT(NLOGIC, I , MODE ) 

C 


IMPLICIT  INTEGER*2  (I-N) 


C 
C 


C   Call  for  Input. 

CALL  INOUT(NIN, 1, 1) 
C   Call  for  Output. 

CALL  I NOUT (NOUT, 2,0) 
C   Call  for  Output-Print. 

CALL  I NOUT (NPR I NT, 3 , 0 
C 

RETURN 

END 
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SUBROUTINE  INOUT ( NLOGIC , I ,MODE) 

(~xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx*xxxxxxxxxxxx 

c 

C   This   Subroutine   permits   to   OPEN  Devices  or/and  Files  to 

C   associate  within  any   FORTRAN   Program  or  Subroutine  at  RUN 

C   time. 

C 

C   ARGUMENTS  : 

C 

C     NLOGIC  :  FORTRAN  logical  number  associate  to  the  unit  to 

C  OPEN,  (NIN,  NOUT,NPRINT  in  the  calling  module). 

C      I       :  Index  (1):  Input,  (2):  OUTput  (for   terminal  in 

C  general),  (3)  :  Print-Output   (for   Printer   or 

C  Fi le  in  general ) . 

C     MODE    :  (0):  'NEW,  (1):  'OLD',  otherwise:  'unknown'. 

C 

c 

C   SUBROUTINE  Called  :  None. 
C 

£xxxxxxxx***x*xxxxx***xx**xx*xxxxxxxxxxxxx 

IMPLICIT  INTEGER*2  (I-N) 

c 

CHARACTERS  0  KEY,NUL 
C   KEY  is  Accept  via  the  Keyboard  at  RUN  time. 

CHARACTER*28  DEV(3) 
C   DEV()  is  Typed  on  the  Terminal  in  fonction  of  I. 

CHARACTER*  3  STA(3) 
C   STA( )  is  referenced  as  'NEW, 'OLD'  or  'unknown'  in  fonction 
C      of  MODE. 

DIMENSION  NSYS( 3) , INCOM( 3) 
C   NSYS()   represents   the   general   used   logical  numbers  for 
C      Input,   Output   and    Print;    INCOM( ) ,    the    relative 
C      incompatibility  for  the  NSYS ( ) ' s . 
C 

DATA  NUL/'   ' / 

DATA  DEV/'  Input  Device  (or  File)    :  ',' Output  Device 

1  (or  File)    :  ','   Print  Device  (or  File)    :  '/ 

DATA  STA/'NEW , 'OLD' , '     '/ 

DATA  NSYS/5,6,6/INCOM/6,5, 5/ 
C   Incompatibilities  Input  with  Output  in  general. 
C 

I F ( NLOG I C . EQ . NSYS ( I ) ) RETURN 

IF(NLOGIC.GT.O . AND . NLOGIC . NE . INCOM( I ) ) GO  TO  1 

NLOGIC=NSYS( I ) 

RETURN 
C   On  System  Terminal. 
1      TYPE  100 ,DEV( I ) 
100    FORMAT(/' $  ' ,A28) 

ACCEPT  2 0  0, KEY 
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200    FORMAT (A40) 

I F ( KEY . EQ . NUL ) RETURN 
C   If  Change. 

CLOSE(NLOGIC) 

I F ( MODE . LT . 0 . OR . MODE . GT . 2 ) MODE=  2 

OPEN ( un i  t  =  NLOG I C , f  i le  =  KEY , s  t  at us  =  ST A ( MODE+ 1 )  ) 
RETURN 
END 


SUBROUTINE  REJECT ( LEC ,  IMP,NROW,  I J ,  IND ,  I ,  I B  IT ,  I  OPEN, 
1  ICLOSE) 

C 

C  Subroutine   for   rejection  of  rows  ("logical  suppression"); 

C  these   rows   are   not   physically   suppressed   but  are  just 

C  eliminated   from   future   calculus   if   the   Ith.   row   is 

C  associated  to  the  binary  value   zero   store  in  the  assigned 

C  rejected  values  support  "binary"  sequential   file   given  by 

C  the  user. 
C 

C  ARGUMENTS  : 

C  LEC,  IMP  :  Input/Output  logical  numbers  for  Terminal. 

C  NROW     :  Total   number   of   rows   for   the   Data    matrix 

C  NCOL*NROW. 

C  IJ        :  Integer   array   that   contains  compressed  binary 

C  information  for  rejection. 

C  IND       :  If  IND=0  :  to  examine  bits  level. 

C  If  IND=1  :  to  load  bits  level. 

C  I         :  Ith  examination  if  IND=0. 

C  IBIT      :  Bit  value  0  or  1  to  return  if  IND=0. 

C  IOPEN     :  If   equal   to   1,   to   open  a  sequential  file  to 

C  store  [0,1]. 

C  ICLOSE    :  If  equal  to  1,  to  close  the  sequential  file. 

C 

C  SUBROUTINES  called  :  COMP01  for  binary  compression, 

C  BIT01   for  bits  manipulation. 

C 

IMPLICIT  INTEGER*2  (I-N) 

C  Compression   :   dimension   of   IJ()   =  2048/NBITW  to  read  a 

C  single  record. 


INTEGER* 2  NOROW(2  04  8) ,NO(2048),IJ(128 

CHARACTER*45  DEVDI R , NAME* 10 
CHARACTER*7  MODROW 
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DATA  DEVDIR,NAME/'DUAO  :','  * / 

DATA  MODRCW/ ' rows' /LOGSUP/8/NCOLS , J/2*1/NBITW/16/ 

MAXD I M= ( NRCW*NCOLS -  1 ) / N3 ITW+ 1 

IF  (IND.EQ.l)  THEN 

IF  ( IOPEN.EQ. 1)  THEN 
C  Assign   rejected   rows  support  "binary"  sequent 

C  file  according  to  the  WRITE  FORMAT  300. 

WRITE( IMP, 100) 

CALL  FICH  ( '076' , LOGSUP , 1 , DEVOIR, NAME, 1, 10  24 ,0, 
1  'SEQUENTIAL' , LEC , IMP) 

END  IF 
C        Select  rejected  rows  ("logical  suppression"). 
WRITE ( IMP, 20  0) 
CALL  ANAD I S ( LEC , IMP , NROW , NROW , NOROW , N3RCW , MODRCW ) 

C        Initialization  :  Set  all  values  to  1. 

CALL    COMP0K IJ,MAXDIM,NCOLS,NROW, I , J , 1 , NBITW, 1 , 1 ) 

C        Change  selected  rejectabie  values  to  0. 
DO  L=l,NBROW 

CALL  COMP0K IJ,MAXDIM,NCOLS,NROW,NOROW(L) , J,0, 
1  NBITW, 2,1) 

END  DO 

WRITE(LOGSUP, 300) IJ 
ELSE 

IF  (IOPEN.EQ. 1)  THEN 
C  Assign   rejected   rows  support  "binary"  sequent 

C  file  according  to  the  WRITE  FORMAT. 

WRITE( IMP, 100) 

CALL  FICH( ' 076' , LOGSUP , 1 , DEVDIR, NAME , 1, 10  2  4, 1, 
1  ' SEQUENTIAL' , LEC, IMP) 

READ (LOGSUP' 300) IJ 
END  IF 

CALL    COMP0K IJ,MAXDIM,NCOLS,NROW, I , J , I B IT , NB ITW , 2 , 
END    IF 


ial 


0) 


IF  ( ICLOSE.EQ. 1)  CLOSE (LOGSUP 


RETURN 


100    FORMAT ( /4X, ' Assign  sequential  file  for  rejected  values' 

1/4X,42( '-' ) ) 
200    FORMAT(/' $', 3X, ' Assign  rejected  rows  for  calculus  :  ') 
300    FORMAT( 16(818/) ) 

END 

SUBROUTINE  COMP0K  I J , MAXDIM , NCOL , NROW ,  I  , J ,  I  3  IT , NB ITW , 
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1  INI,IND) 

C   This  subroutine  is  used  to  get  or  set  the  binary  value  0  or 

C   1  in  a   compressed   binary  matrix  NROW*NCOL  for  any  I's  and 
C   J's. 


C 
C 
C 
C 

C 

c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 


ARGUMENTS 
IJ      : 


nat 


:  Integer    one    machine   word    by    element 
represents  the  stored  binary  values  (0,1). 

MAXDIM  :  Dimension  of  the  compressed  table  IJ(). 

NCOL    :  Maximum  value  for  the  J's,  (number  of  columns). 

NROW    :  Maximum  value  for  the  I's,  (number  of  rows). 

I,  J    :  Actual  value  for  I  and  J. 

IBIT    :  Set  of  return  the  binary  value. 

NBITW   :  Number  of  bits  per  word  (16,  32,  36). 

INI     :  If  0  or  1,  initialize  to  one  of  these  values, 
otherwise,  no  action. 

IND     :  If  IND=0  :  examine  bits  level  and  return  the  value 
IBIT, 

If  IND=1  :  Set  bit  level  to  the  current  IBIT. 


SUBROUTINE  called 


BIT01  for  bits  man ioulat ion: 


C 

c 


'it************************************************************ 

IMPLICIT  INTEGER*2  ( I-N) 

INTEGER* 2  I J (MAXDIM) ,3ITSET( 36) , 3IT( 36) 

Initialization  to  0  or  1. 


INIT=0 

IF  (INI .EQ.0.OR. INI.EQ.l)  THEN 
IF  ( INI .EQ. 1) . INIT=-1 
DO  K=l, MAXDIM 
IJ(K)=INIT 
END  DO 

ELSE 

C   Process  to  examine  or  set  bits  for  the  actual  I's  and  J's. 
c   

C   PHASE   I  :  Calculate  bit  no.  :  NOBIT,  index   NOW  of  the  one 

C   word  array   IJ()   and  position  NOPOS  in  the  word 

C  ( 1  to  NBITW) . 

NOBIT=J+NCOL*( 1-1 ) 

NOW   =(NOBIT-l)/NBITW+l 

NOPOS=NOBIT-(NOW-l) *NBITW 
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C   PHASE  II  :  examine  and  return  I BIT  or  set  to  I BIT  for  any  I 

C   and  J. 

C  Set  the  correct  bit  to  the  value  IND,  without  effect  on  the 
C   other  bits  of  IJ(NOW). 

IF  (IND.EQ.l)  THEN 

DO  K=l, NBITW 
BITSET(K)=2 

END  DO 

BITSET(NOPOS) =IBIT 

CALL  BIT01  (IJ(NOW) , IND, BIT, BITSET, NBITW) 
ELSE 

C  Examine  the  correct  bit  value  of  IJ(NOW). 

CALL  BIT01  ( IJ (NOW) , IND, BIT, BITSET, NBITW) 
IBIT=BIT(NOPOS) 

END  IF 
END  IF 

RETURN 

END 

SUBROUTINE  BITOK I , IND , 3  IT , B ITSET , NB ITW ) 

C  Machine  independent  subroutine  to  examine  or  set  to  a  value 
C  0  or  1  the  bits  of  any  machine  word  equivalent  to  a  given 
C   integer  I  . 


c 

ARGUMENTS 

c 

c 

NBITW 

c 

c 

c 

c 

I 

c 

IND 

c 

c 

c 

c 

c 

BIT  (  ) 

c 

BITSET( ) 

c 

c 

c 

c 

Number  of  bits  per  machine  word  or  considered  by 
the   system.    For    the    VAX11,   NBITW=16   and 

INTEGER* 2.    (NBITWth 9th, 8th, 7th, bth, 5th, 

4 1  h  ,  3 1  h , 2  nd , 1 nd ) 

INTEGER   (NBITW  bits)   (ex.:  N3ITW=16,  32  OR  36) 

If   IND=0   :   examine   the   NBITW  bits  level  and 

store  the  result  in  BIT(). 

If  IND=0   :   set   the   NBITW   bits   level   of   I 

according  the  elements  of  BITSET()  equal  to  0  or 

1. 

Give  the  content  of  the  NBITW  bits  of  I. 

If  the  content  is  0,  set  the  corresponding  bit  of 

I  to  0  , 

If  the  content  is  1,  set  the  corresponding  bit  of 

I  to  1 , 

otherwise,  no  effect  on  the  integer  I. 
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c 

C   REFERENCE  : 

C 

C   GUINIER  D.   (1983)   :   High   level   mult  i  language    machir.e- 

C  independent  prog r animation   (16,   32,  3  6  bits)  :  A 

C  subroutine   for   bits   manipulations  in  BASIC    and 

C  FORTRAN  IV.   DECUS ,   RT11  SIG,  Mini-Tasker,  voi9, 

C  no. 4,  10-1983. 

C 

IMPLICIT  INTEGER*2  (i-N) 
INTEGER*2  BITSET ( 3 6 )  , 3  IT ( 36 ) 


C   PHASE  I  :  Search  of  the  bits' level  for  the  field  intege: 
c   __. 

C     Examination  of  the  bits  level  of  the  integer  I. 


NBR=NBITW-1 
IP=I 

B I T ( NB I TW ) =  0 
IF(IP.LT.O)  THEN 
C         IP  is  previously  a  negative  integer. 

BIT(NBITW)=1 

IP=IP+2 . **(NBITW-1) 
END  IF 
C  IP  is  a  positive  integer. 

DO  J=l ,NBR 

BIT(J)=M0D( IP, 2) 

IP=IP/2 
END  DO 

IF  (IND.EQ.O)  RETURN 

C   PHASE  II  :  Possible  changes  of  the  actual  level  of  the  bits. 
c   

C     Set  bits  of  integer  I  to  0  or  1  if  required. 

DO  J=l ,NBITW 

IF  ( B I TSET ( J ) . NE . 0 )  THEN 

IF  (BITSET(J) .EQ. 1)  THEN 
BIT    (J)=  1 
BITSET(J)=-1 
END  IF 
ELSE 

BIT    (J)=  0 
BITSET(J)=-1 
END  IF 
END  DO 
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C  PHASE  III  :  Releasing  of  a  new 

c  : 

C                    of  levels . 
C  


Id  i n t e g e : 


e  r  c  r.  a  n  c  e 


C   Integer  I  reconst i tut  ion  using  Horner  Scheme. 

I=BIT(NBR) 

N=N3R-1 

DO  J=N, 1,-1 

I=I*2+BIT(J) 
END  DO 

C      If  I  is  a  negative  number. 

IF  (BIT(NBITW) .EQ.l)  1= 1-2 . ** (NBITW-1 ) 

RETURN 

END 
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